elm/Eval.elm

   1 module Eval exposing (..)
   2
   3 import Types exposing (..)
   4 import IO exposing (IO)
   5
   6
   7 apply : Eval a -> EvalState -> EvalContext a
   8 apply (Eval f) state =
   9     f state
  10
  11
  12 run : EvalState -> Eval a -> EvalContext a
  13 run state e =
  14     apply e state
  15
  16
  17 withState : (EvalState -> Eval a) -> Eval a
  18 withState f =
  19     Eval <|
  20         \state ->
  21             apply (f state) state
  22
  23
  24 putState : EvalState -> Eval ()
  25 putState state =
  26     Eval <|
  27         \_ ->
  28             apply (succeed ()) state
  29
  30
  31 modifyState : (EvalState -> EvalState) -> Eval ()
  32 modifyState f =
  33     Eval <|
  34         \state ->
  35             apply (succeed ()) (f state)
  36
  37
  38 succeed : a -> Eval a
  39 succeed res =
  40     Eval <|
  41         \state ->
  42             ( state, EvalOk res )
  43
  44
  45 io : Cmd Msg -> (IO -> Eval a) -> Eval a
  46 io cmd cont =
  47     Eval <|
  48         \state ->
  49             ( state, EvalIO cmd cont )
  50
  51
  52 map : (a -> b) -> Eval a -> Eval b
  53 map f e =
  54     Eval <|
  55         \state ->
  56             case apply e state of
  57                 ( state, EvalOk res ) ->
  58                     ( state, EvalOk (f res) )
  59
  60                 ( state, EvalErr msg ) ->
  61                     ( state, EvalErr msg )
  62
  63                 ( state, EvalIO cmd cont ) ->
  64                     ( state, EvalIO cmd (cont >> map f) )
  65
  66
  67 andThen : (a -> Eval b) -> Eval a -> Eval b
  68 andThen f e =
  69     Eval <|
  70         \state ->
  71             case apply e state of
  72                 ( state, EvalOk res ) ->
  73                     apply (f res) state
  74
  75                 ( state, EvalErr msg ) ->
  76                     ( state, EvalErr msg )
  77
  78                 ( state, EvalIO cmd cont ) ->
  79                     ( state, EvalIO cmd (cont >> andThen f) )
  80
  81
  82
  83 -- Debug.log "wrapping EvalIO" ( state, EvalIO cmd cont )
  84
  85
  86 fail : String -> Eval a
  87 fail msg =
  88     Eval <|
  89         \state ->
  90             ( state, EvalErr msg )