Skip to content

Instantly share code, notes, and snippets.

@wende
Last active October 5, 2017 14:26
Show Gist options
  • Save wende/2a515b81ea49f7d33e0a5a2e7e4667c6 to your computer and use it in GitHub Desktop.
Save wende/2a515b81ea49f7d33e0a5a2e7e4667c6 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment