tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

io.tri (5118B)

      1 !import "prelude"  !Local
      2 !import "patterns" !Local
      3 
      4 -- IO constructors for host-interpreted interaction trees.
      5 -- Free-monad style: Bind is the single sequencing mechanism.
      6 
      7 version = 1
      8 
      9 io        = action : pair "tricuIO" (pair version action)
     10 
     11 pure      = x          : pair 0 x
     12 bind      = action k   : pair 1 (pair action k)
     13 
     14 putStr    = s          : pair 10 s
     15 getLine   = pair 11 t
     16 
     17 readFile  = p          : pair 20 p
     18 writeFile = p c        : pair 21 (pair p c)
     19 putBytes  = bs         : pair 12 bs
     20 writeBytes = p c       : pair 22 (pair p c)
     21 
     22 listDirectory   = p          : pair 23 p
     23 renameFile      = old new    : pair 24 (pair old new)
     24 createDirectory = p          : pair 25 p
     25 deleteFile      = p          : pair 26 p
     26 fileExists      = p          : pair 27 p
     27 
     28 sha256Hex       = bs         : pair 28 bs
     29 currentTime     = pair 29 t
     30 
     31 ask       = pair 30 t
     32 local     = f action   : pair 31 (pair f action)
     33 
     34 get       = pair 40 t
     35 put       = s          : pair 41 s
     36 
     37 fork      = action     : pair 60 action
     38 await     = handle     : pair 61 handle
     39 yield     = pair 62 t
     40 sleep     = ms         : pair 63 ms
     41 
     42 -- ---------------------------------------------------------------------------
     43 -- Generic sequencing combinators
     44 -- ---------------------------------------------------------------------------
     45 
     46 thenIO = a b : bind a (_ : b)
     47 mapIO  = action f : bind action (x : pure (f x))
     48 void   = action : bind action (_ : pure t)
     49 
     50 -- ---------------------------------------------------------------------------
     51 -- Conditional execution
     52 -- ---------------------------------------------------------------------------
     53 
     54 when   = cond action : matchBool action (pure t) cond
     55 unless = cond action : matchBool (pure t) action cond
     56 
     57 -- ---------------------------------------------------------------------------
     58 -- Infinite loop
     59 -- ---------------------------------------------------------------------------
     60 
     61 forever = y (self : action :
     62   bind action (_ :
     63     self action))
     64 
     65 -- ---------------------------------------------------------------------------
     66 -- Result-aware combinators
     67 -- ---------------------------------------------------------------------------
     68 
     69 -- Propagate driver Result on error; run okCase on success.
     70 onOk = action okCase :
     71   bind action (result :
     72     matchResult
     73       (err rest : pure result)
     74       okCase
     75       result)
     76 
     77 -- Same as onOk, but the okCase only receives the value (rest is dropped).
     78 onOk_ = action okCase :
     79   bind action (result :
     80     matchResult
     81       (err rest : pure result)
     82       (val _ : okCase val)
     83       result)
     84 
     85 -- Generalized Result handler with explicit branches.
     86 onResult = action errCase okCase :
     87   bind action (result :
     88     matchResult errCase okCase result)
     89 
     90 -- Same as onResult, but handlers only receive the value/msg (rest is dropped).
     91 onResult_ = action errCase okCase :
     92   bind action (result :
     93     matchResult
     94       (err _ : errCase err)
     95       (val _ : okCase val)
     96       result)
     97 
     98 mapErrIO prefix action =
     99   onResult_ action
    100     (e : pure (err (append prefix e) t))
    101     (v : pure (ok v t))
    102 
    103 -- ---------------------------------------------------------------------------
    104 -- Convenience helpers
    105 -- ---------------------------------------------------------------------------
    106 
    107 print    = s : void (putStr s)
    108 putStrLn = s : void (putStr (append s "\n"))
    109 
    110 -- ---------------------------------------------------------------------------
    111 -- Result-aware file helpers
    112 -- ---------------------------------------------------------------------------
    113 
    114 onReadFile = path : onResult (readFile path)
    115 
    116 onWriteFile = path contents : onResult (writeFile path contents)
    117 
    118 onListDirectory   = path : onResult (listDirectory path)
    119 onRenameFile      = old new : onResult (renameFile old new)
    120 onCreateDirectory = path : onResult (createDirectory path)
    121 onDeleteFile      = path : onResult (deleteFile path)
    122 onFileExists      = path : onResult (fileExists path)
    123 onSha256Hex       = bs : onResult (sha256Hex bs)
    124 onCurrentTime     = onResult currentTime
    125 
    126 -- ---------------------------------------------------------------------------
    127 -- Convenience helpers for the common cases
    128 -- ---------------------------------------------------------------------------
    129 
    130 readFileOrPrintError = (path okCase :
    131   onReadFile path
    132     (err rest : putStrLn (append "Read failed: " err))
    133     okCase)
    134 
    135 writeFileOrPrintError = (path contents okCase :
    136   onWriteFile path contents
    137     (err rest : putStrLn (append "Write failed: " err))
    138     okCase)
    139 
    140 copyFile = (src dst :
    141   onResult (readFile src)
    142     (err rest : putStrLn (append "Read failed: " err))
    143     (contents rest :
    144       onResult (writeFile dst contents)
    145         (err rest : putStrLn (append "Write failed: " err))
    146         (_ _ : pure t)))
    147 
    148 -- ---------------------------------------------------------------------------
    149 -- Resource-safe combinators
    150 -- ---------------------------------------------------------------------------
    151 
    152 finally = action cleanup :
    153   bind action (result :
    154     bind cleanup (_ :
    155       pure result))
    156 
    157 bracket = acquire release use :
    158   bind acquire (resource :
    159     bind (use resource) (result :
    160       bind (release resource) (_ :
    161         pure result)))