Parallel Task/Cmd

Parallel.elm

module Parallel exposing
    ( Data(..), Parallel, OneOf
    , succeed, appendCmd, appendTask, append, map2
    , andThen
    , Msg, init, run, update
    , Parallel1, Parallel2, Parallel3, Parallel4, Sequential
    )

{-| Allows easily running tasks/cmd in parallel without manually needing to manage messages.

Supports any number of tasks.

@docs Data, Parallel, OneOf


### Constructing

@docs succeed, appendCmd, appendTask, append, map2


### Sequential operations

While operations constructed with the other functions will run in parallel, sometimes you also need operations to run sequentially.

@docs andThen


### Running

@docs Msg, init, run, update


### Type aliases

The functions here can generate some awful type signatures, but this can be somewhat ameliorated by using type aliases.

@docs Parallel1, Parallel2, Parallel3, Parallel4, Sequential

-}

import Browser.Dom
import Platform exposing (Task)
import Task


{-| This whole thing runs on an RemoteData like abstraction.
-}
type Data err a
    = Loading
    | Error err
    | Loaded a


type Msg err a next
    = Curr (Result err a)
    | Next next


{-| A generalized sum type - basically the sum type equivalent of a Tuple.
-}
type OneOf a b
    = A a
    | B b


{-| Represents a parallel series of effect with heterogeneous types (but homogenous error types \*).

Typically this will be defined statically, but run dynamically with `run`.

\* if you want heterogenous error types, nothing stops you from loading in `Result` inside the success types, then handling failure manually.

-}
type Parallel inp err state msg todo
    = Parallel
        { state : state
        , cmd : inp -> Cmd msg
        , update : msg -> state -> state
        , complete : state -> OneOf ( inp -> Cmd msg, state ) (Data err todo)
        }



-- Helpers


mapCmd : (a -> msg) -> (c -> Cmd a) -> c -> Cmd msg
mapCmd fn cmdFn inp =
    cmdFn inp |> Cmd.map fn


mapCmd2 : (a -> msg) -> (b -> msg) -> (c -> Cmd a) -> (c -> Cmd b) -> c -> Cmd msg
mapCmd2 fn1 fn2 cmdFn1 cmdFn2 inp =
    Cmd.batch [ Cmd.map fn1 (cmdFn1 inp), Cmd.map fn2 (cmdFn2 inp) ]


dataMap2 : (a -> b -> c) -> Data err a -> Data err b -> Data err c
dataMap2 fn a b =
    case a of
        Loaded done ->
            case b of
                Loaded l ->
                    Loaded (fn done l)

                Error err ->
                    Error err

                Loading ->
                    Loading

        Error err ->
            Error err

        Loading ->
            Loading



-- Type aliases
-- These make the types a bit less verbose at the cost of some indirection


{-| Denotes a Parallel that performs one operation after another.
-}
type alias Sequential inp err stateA stateB msgA msgB todo =
    Parallel inp err (OneOf stateA ( Parallel inp err stateB msgB todo, stateB )) (OneOf msgA msgB) todo


{-| -}
type alias Parallel1 inp err a state msg todo =
    Parallel inp err ( Data err a, state ) (Msg err a msg) todo


{-| -}
type alias Parallel2 inp err a b state msg todo =
    Parallel1 inp err a ( Data err b, state ) (Msg err b msg) todo


{-| -}
type alias Parallel3 inp err a b c state msg todo =
    Parallel2 inp err a b ( Data err c, state ) (Msg err c msg) todo


{-| -}
type alias Parallel4 inp err a b c d state msg todo =
    Parallel3 inp err a b c ( Data err d, state ) (Msg err d msg) todo


andThen : (a -> Parallel inp err stateB msgB b) -> Parallel inp err stateA msgA a -> Sequential inp err stateA stateB msgA msgB b
andThen fn (Parallel p) =
    Parallel
        { state = A p.state
        , cmd = mapCmd A p.cmd
        , update =
            \msg model ->
                case ( msg, model ) of
                    ( A amsg, A amodel ) ->
                        A (p.update amsg amodel)

                    ( B bmsg, B ( Parallel newP, bmodel ) ) ->
                        B ( Parallel newP, newP.update bmsg bmodel )

                    _ ->
                        model
        , complete =
            \model ->
                case model of
                    A amodel ->
                        case p.complete amodel of
                            A ( cmd, state ) ->
                                A ( mapCmd A cmd, A state )

                            B l ->
                                case l of
                                    Loaded x ->
                                        let
                                            (Parallel newP) =
                                                fn x
                                        in
                                        A ( mapCmd B newP.cmd, B ( Parallel newP, newP.state ) )

                                    Error err ->
                                        B (Error err)

                                    Loading ->
                                        B Loading

                    B ( Parallel newP, bmodel ) ->
                        case newP.complete bmodel of
                            A ( cmdFn, state ) ->
                                A ( mapCmd B cmdFn, B ( Parallel newP, state ) )

                            B done ->
                                B done
        }


{-| Give a function that is run once all the cmds have succeeded to collate the final result.
-}
succeed : fn -> Parallel input err () () fn
succeed fn =
    Parallel
        { state = ()
        , cmd = \_ -> Cmd.none
        , update = \_ _ -> ()
        , complete = \_ -> B (Loaded fn)
        }


{-| Adds a cmd that can fail.
-}
append : (input -> Cmd (Result err a)) -> Parallel input err rest next (a -> done) -> Parallel input err ( Data err a, rest ) (Msg err a next) done
append newCmd (Parallel p) =
    Parallel
        { state = ( Loading, p.state )
        , cmd = mapCmd2 Curr Next newCmd p.cmd
        , update =
            \msg ( this, next ) ->
                case msg of
                    Curr val ->
                        ( case val of
                            Ok ok ->
                                Loaded ok

                            Err err ->
                                Error err
                        , next
                        )

                    Next smg ->
                        ( this, p.update smg next )
        , complete =
            \( this, next ) ->
                case p.complete next of
                    A ( cmdFn, state ) ->
                        A ( mapCmd Next cmdFn, ( this, state ) )

                    B l ->
                        B (dataMap2 (\fn val -> fn val) l this)
        }


{-| Adds a cmd that cannot fail.
-}
appendCmd : (input -> Cmd a) -> Parallel input err rest next (a -> done) -> Parallel input err ( Data err a, rest ) (Msg err a next) done
appendCmd cmd =
    append (mapCmd Ok cmd)


{-| Adds a task
-}
appendTask : (input -> Task err a) -> Parallel input err rest next (a -> done) -> Parallel input err ( Data err a, rest ) (Msg err a next) done
appendTask task =
    append (\x -> Task.attempt identity (task x))


{-| Create the initial state (this will go into your model in your init function).
-}
init : Parallel input err state msg done -> state
init (Parallel { state }) =
    state


{-| Actually run the computation (give it a wrapper msg).
-}
run : (innerMsg -> msg) -> input -> Parallel input err state innerMsg done -> Cmd msg
run fn input (Parallel { cmd }) =
    mapCmd fn cmd input


{-| This is what you run in your update function. It returns the new state and the state of whatever you wanted to compute.
-}
update : input -> Parallel input err state msg done -> msg -> state -> ( state, Data err done, Cmd msg )
update input (Parallel p) msg state =
    let
        newState =
            p.update msg state
    in
    case p.complete newState of
        A ( cmdFn, s ) ->
            ( s, Loading, cmdFn input )

        B res ->
            ( newState, res, Cmd.none )


{-| -}
map2 : (a -> b -> c) -> Parallel input err state1 msg1 b -> Parallel input err state0 msg0 a -> Parallel input err ( state0, state1 ) (OneOf msg0 msg1) c
map2 fn (Parallel p1) (Parallel p2) =
    Parallel
        { state = ( p2.state, p1.state )
        , cmd = mapCmd2 A B p2.cmd p1.cmd
        , update =
            \msg ( this, next ) ->
                case msg of
                    A val ->
                        ( p2.update val this
                        , next
                        )

                    B smg ->
                        ( this, p1.update smg next )
        , complete =
            \( this, next ) ->
                case p2.complete this of
                    A ( cmdFn, state ) ->
                        A ( mapCmd A cmdFn, ( state, next ) )

                    B l ->
                        case p1.complete next of
                            A ( cmdFn, state ) ->
                                A ( mapCmd B cmdFn, ( this, state ) )

                            B x ->
                                B (dataMap2 fn l x)
        }



---- Example


type alias MyRec =
    { viewport : Browser.Dom.Viewport
    , element : Browser.Dom.Element
    }


myVal : Parallel2 () Browser.Dom.Error Browser.Dom.Element Browser.Dom.Viewport () () MyRec
myVal =
    succeed MyRec
        |> appendTask (always Browser.Dom.getViewport)
        |> appendTask (always (Browser.Dom.getElement "foo"))