!import "base" !Local
!import "list" !Local
!import "contracts" !Local

-- A custom 'and' combinator written directly against base.matchResult.
-- It succeeds only when *both* contracts succeed, threading the checked value
-- from the first into the second. This makes the Result pair structure explicit.
myAndC = (c1 c2 value rest :
  matchResult
    (msg _ : contractErr msg rest)
    (v _ : c2 v rest)
    (c1 value rest))

-- Plain predicates lifted into contracts with a diagnostic message.
natural? = guardC "natural" (n : gte? n 0)
nonZero? = guardC "non-zero" (n : not? (isZero? n))

-- Safe wrappers around partial base / list functions.
-- The frontend desugars @ and =@ into runtime withContract applications.
safeDiv a@natural? b@(myAndC natural? nonZero?) =@natural? div a b

safeHead xs@(nonEmptyListOf anyC) =@anyC head xs
safeTail xs@(nonEmptyListOf anyC) =@(listOf anyC) tail xs

-- A higher-order wrapper: the supplied function must satisfy a contract,
-- the input list must satisfy a contract, and the result list is guaranteed.
checkedMap f@(fnContract anyC natural?) xs@(listOf anyC) =@(listOf natural?) map f xs

-- Advertise the safe wrappers in the module manifest with their own contracts.
!export safeDiv : fn2 natural? nonZero? natural?
!export safeHead : fnContract (nonEmptyListOf anyC) anyC
!export checkedMap : fn2 (fnContract anyC natural?) (listOf anyC) (listOf natural?)

-- A small interaction-tree pipeline that uses contracts as recoverable effects.
pipeline = (input :
  do bindM
    scaled <- checkM natural? (mul input 2)
    half   <- handleM "contract"
                  (_ : pureM 1)
                  (checkM nonZero? (sub scaled 4))
    pureM (div scaled half))

main = runM (pipeline 5)