Last active
October 5, 2017 14:26
-
-
Save wende/2a515b81ea49f7d33e0a5a2e7e4667c6 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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