krzysztof-w
8/29/2017 - 9:37 PM

TypeSafeGenServer.elm

module SingletonIncrementer exposing (..)

{-| Experiment on implementing type-safe OTP compliant GenServer
-}

import Platform exposing (Task(..))
import Task
import Time


--- Here starts an exemplary API implementation


type OTPErrors
    = NetSplit
    | ProcessNotFound


type alias Process success =
    Task OTPErrors success

{-| Executes a cast command which can modify the state and always returns a Result type -}
cast :
    msg
    -> (state -> state)
    -> Process Result
cast msg response =
    Debug.crash "Crash"

{-| Executes a cast command which can rely on further commands. 
Everything in Process state will get executed _after_ the Process Ressult returns. -}
castCmd :
    msg
    -> (state -> Process state)
    -> Process Result
castCmd msg response =
    Debug.crash "Crash"

{-| Executes a call command which can modify the state and return a result of any type to the caller -}
    msg
    -> (state -> ( reply, state ))
    -> Process reply
call msg =
    Debug.crash "Crash"

{-| Executes a call command which can modify the state and return a result of any type to the caller
Everything in Process state will get executed _before_ the Process reply returns -}
callCmd :
    msg
    -> (state -> Process ( reply, state ))
    -> Process reply
callCmd msg =
    Debug.crash "Crash"


type alias GenServer state msg reply =
    { call :
        msg
        -> (state -> ( reply, state ))
        -> Process reply
    , callCmd :
        msg
        -> (state -> Process ( reply, state ))
        -> Process reply
    , cast :
        msg
        -> (state -> state)
        -> Process Result
    , castCmd :
        msg
        -> (state -> Process state)
        -> Process Result
    }


singleton : Process state -> GenServer state msg reply
singleton init =
    { call = call, cast = cast, callCmd = callCmd, castCmd = castCmd }



-- After this line everything is a GenServer examplary definition


process : GenServer number Msg reply
process =
    singleton <| Task.succeed 0


type Msg
    = Add
    | Increment
    | Decrement
    | Reset
    | SetToTimeNow
    | Set
    | Get


add : number -> Process Result
add a =
    process.cast Add <| (+) a


increment : Process Result
increment =
    process.cast Increment <| (+) 1


decrement : Process Result
decrement =
    process.cast Decrement <| (-) 1


reset : Process Result
reset =
    process.cast Reset <| always 0


set : number -> Process Result
set to =
    process.cast Set <| always to


setToNow : Process Result
setToNow =
    process.castCmd SetToTimeNow <| always Time.now


get : Process number
get =
    process.call Get <| \state -> ( state, state )



------ After this line only testing functions are defined


(>>=) =
    flip Task.andThen


testFlow : Process number
testFlow =
    reset
        >>= always increment
        >>= always decrement
        >>= always get
        >>= (\a -> set <| a + 10)
        >>= always setToNow
        >>= always get