├── .gitignore ├── LICENSE ├── README.md ├── elm.json ├── examples ├── CmdM │ ├── Http.elm │ └── Random.elm ├── IO │ ├── Batch.elm │ ├── Buttons.elm │ ├── CheckBoxes.elm │ ├── Field.elm │ ├── Form.elm │ ├── Hello.elm │ ├── Http.elm │ ├── InfiniteLog.elm │ ├── RadioButtons.elm │ ├── Random.elm │ └── Time.elm ├── Makefile ├── README.md ├── TEA │ ├── Buttons.elm │ ├── CheckBoxes.elm │ ├── Field.elm │ ├── Form.elm │ ├── Http.elm │ ├── RadioButtons.elm │ ├── Random.elm │ └── Time.elm └── elm.json └── src ├── CmdM.elm ├── CmdM └── Internal.elm ├── IO.elm └── IO └── Internal.elm /.gitignore: -------------------------------------------------------------------------------- 1 | # elm-package generated files 2 | elm-stuff 3 | # elm-repl generated files 4 | repl-temp-* 5 | # misc 6 | .vscode 7 | # Html output 8 | *.html 9 | 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017-2019 Christophe Calvès 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Elm-IO 2 | 3 | [Documentation](http://package.elm-lang.org/packages/chrilves/elm-io/latest) 4 | 5 | > Some [rules] can be bent. Others can be broken. Understand? 6 | > *-- Morpheus* 7 | 8 | This projects provides **pure Elm** tools whose aim is to make programming in 9 | Elm more **composable** even if it means bending a bit the rules of [The Elm 10 | Architecture](https://guide.elm-lang.org/architecture/). 11 | 12 | A classic Elm application that follows [The Elm Architecture](https://guide.elm-lang.org/architecture/) is structured like this: 13 | - a `model` data type representing the model at any given time. 14 | - a `msg` data type representing events either fired by the view or the runtime (mouse click, input change, http response, ...) called messages. 15 | - the `update: msg -> model -> (model, Cmd msg)` function is called on every message received to compute the new value of the model. It can output [commands](http://package.elm-lang.org/packages/elm-lang/core/latest/Platform-Cmd#Cmd) which are tasks handled by the runtime. On completion, commands return a message which trigger once again the `update` function. 16 | - the `view: model -> Html msg` renders the current value of the model into HTML content. This HTML can define messages to send on events. 17 | 18 | This approach has some limitations: 19 | - The callback passed to `onInput : (String -> msg) -> Attribute msg` and many other event handlers can decide which message to send based on the input string, but is forced to send one. 20 | - if you want to execute a command in response to an event happening in the view, the view has to trigger a message that will be interpreted by the update function which will output the command ... 21 | - the command type ([Cmd](http://package.elm-lang.org/packages/elm-lang/core/latest/Platform-Cmd#Cmd)) is not a monad. It means commands do not compose! For example chaining commands has to be handled in the update function or by using another type such as [tasks](http://package.elm-lang.org/packages/elm-lang/core/latest/Task). 22 | 23 | All of this makes perfect sense from an architectural point of view. [The Elm Architecture](https://guide.elm-lang.org/architecture/) has many benefits like isolation of rendering, state and effects. This project is for those ready to trade these benefits for more *flexibility* and *conciseness*. If your update function is littered with command scheduling code or/and your message type looks more like boilerplate than business, then this package is made for you! 24 | 25 | You have two options: 26 | - the [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) approach lets you program the way you used to but lets you trigger commands in the view and chain commands as you like. The model is still updated in the update function, not in the view! 27 | - the [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) approach, in addition of the [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM)'s benefits, lets you read and write the state directly in commands. You can then alter the state directly from the view. 28 | 29 | ## The [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) monad 30 | 31 | The [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) 32 | monad is the command type ([Cmd](http://package.elm-lang.org/packages/elm-lang/core/5.1.1/Platform-Cmd#Cmd)) turned into a monad. 33 | It enables to chain effects easily using classic monadic operations without 34 | having to encode complex scheduling in the update function. 35 | 36 | A program using [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) 37 | is generally built arround 38 | [CmdM.program](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#program), 39 | [CmdM.vDomProgram](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#vDomProgram), 40 | [CmdM.programWithFlags](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#programWithFlags) 41 | or [CmdM.vDomProgramWithFlags](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#vDomProgramWithFlags) 42 | depending on if this is a headless program or if flags are required. For more specific needs, 43 | you can use [CmdM.transform](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#transform) 44 | and [CmdM.transformWithFlags](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#transformWithFlags). 45 | 46 | [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) is used very much like 47 | [Cmd](http://package.elm-lang.org/packages/elm-lang/core/5.1.1/Platform-Cmd#Cmd). The main difference 48 | is the view outputs `Html (CmdM Msg)` instead of `Html Msg`. You're not forced to refactor your view 49 | to use [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM): 50 | 51 | ```elm 52 | classicTeaView: Model -> Html Msg 53 | 54 | cmdmView: Model -> Html (CmdM Msg) 55 | cmdmView model = classicTeaView |> Html.map CmdM.pure 56 | ``` 57 | 58 | The general way of using [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) is 59 | lifting a `Cmd a` value into a `CmdM a` one by [CmdM.lift](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#lift) 60 | and chain them by [CmdM.andThen](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#andThen) or [CmdM.ap](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM#ap). The module [CmdM.Infix](package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM-Infix) provides infix notation for these operators. 61 | 62 | 63 | ## The [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) monad 64 | 65 | The [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) monad 66 | is like the [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) monad 67 | enriched with state altering effect. Thus command effects and model modifications can be 68 | mixed easily. Furthermore the view and subscriptions can not only emit messages but also 69 | [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO)s. 70 | 71 | ### Example 72 | 73 | Here is a complete example of a simple page showing a counter 74 | 75 | ```elm 76 | module Hello exposing (..) 77 | 78 | import Html exposing (..) 79 | import Html.Events exposing(..) 80 | import IO exposing (..) 81 | 82 | type alias Model = Int 83 | type alias Msg = () 84 | 85 | increment : IO Model Msg 86 | increment = IO.modify ((+) 1) 87 | 88 | reset : IO Model Msg 89 | reset = IO.set 0 90 | 91 | view : Model -> Html (IO Model Msg) 92 | view m = 93 | div [] [ 94 | h1 [] [text "Example of an IO program"], 95 | p [] [text ("Counter = " ++ (String.fromInt m))], 96 | button [onClick increment] [text "increment"], 97 | button [onClick reset] [text "reset"] 98 | ] 99 | 100 | main : IO.Program () Model Msg 101 | main = 102 | IO.sandbox { 103 | init = \_ -> (0, IO.none), 104 | view = view , 105 | subscriptions = IO.dummySub 106 | } 107 | ``` 108 | 109 | Like [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM), a program using 110 | [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) is generally built arround one of the 111 | many *IO.\*Program\** functions. These function cover web and headless programs, run with or without 112 | flags. In addition the functions named *beginner\** offer a simple and conside way to run most 113 | [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) programs. For more specific needs, 114 | you can use [IO.transform](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO#transform) 115 | and [IO.transformWithFlags](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO#transformWithFlags). 116 | 117 | With [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO), reading and writing the model 118 | is done with [IO.get](http://package.elm-lang.org/packages/chrilves/elm-io/1.2.1/IO#get), 119 | [IO.set](http://package.elm-lang.org/packages/chrilves/elm-io/1.2.1/IO#set) and 120 | [IO.modify](http://package.elm-lang.org/packages/chrilves/elm-io/1.2.1/IO#modify). 121 | It means this kind of code becomes possible: 122 | 123 | ```elm 124 | action : IO Model Msg 125 | action = 126 | IO.get |> IO.andThen (\model -> -- First we read the model 127 | let 128 | -- The classic Http command 129 | httpCommand : Cmd (Result Error Model) 130 | httpCommand = Http.get { url = "https://example.com/my/api/action" 131 | , expect = Http.expectJson identity decoder 132 | } 133 | in 134 | -- First we lift the Cmd command into IO 135 | -- then compose it by andThen with a function to deal with the response 136 | IO.lift httpCommand |> IO.andThen (\response -> 137 | case response of 138 | Ok newModel -> IO.set newModel -- and set the new model on success 139 | Err _ -> IO.none -- or do nothing on failure 140 | )) 141 | ``` 142 | 143 | Requiring all [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) actions to work 144 | on the whole model would break composability, which would be petty bad obviously. Fortunately 145 | [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) play well with 146 | [optics](https://github.com/arturopala/elm-monocle): 147 | 148 | ```elm 149 | import Monocle.Lens exposing (..) 150 | 151 | -- An IO action whose model is an integer 152 | actionOnInt : IO Int () 153 | actionOnInt = IO.modify (\x -> x + 1) 154 | 155 | type alias Model = { number : Int, name : String } 156 | 157 | lensFromIntToModel : Lens Model Int 158 | lensFromIntToModel = 159 | { get = \model -> model.number, 160 | set = \i model -> { model | number = i } 161 | } 162 | 163 | -- an IO action whose model is a Model 164 | actionOnModel : IO Model () 165 | actionOnModel = IO.lens lensFromIntToModel actionOnInt 166 | ``` 167 | 168 | To avoid having to use optics when not needed, it is advised to use [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) 169 | for model agnostic actions and lift [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) to 170 | [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) at the last moment by 171 | [IO.liftM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO#liftM). 172 | 173 | ## Examples from http://elm-lang.org/examples translated into [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) and [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) 174 | 175 | The [examples](https://github.com/chrilves/elm-io/tree/master/examples) folder contains examples from http://elm-lang.org/examples converted into [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) 176 | and [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) ways. Please read the [README.md](https://github.com/chrilves/elm-io/tree/master/examples/README.md) file in this folder for more details on examples. 177 | 178 | ## Need help? 179 | 180 | If you have questions and/or remarks, contact me on twitter at [@chrilves](https://twitter.com/chrilves) -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "chrilves/elm-io", 4 | "summary": "Monadic interface for commands and The Elm Architecture", 5 | "license": "MIT", 6 | "version": "2.0.0", 7 | "exposed-modules": [ 8 | "IO", 9 | "CmdM" 10 | ], 11 | "elm-version": "0.19.0 <= v < 0.20.0", 12 | "dependencies": { 13 | "arturopala/elm-monocle": "2.0.0 <= v < 3.0.0", 14 | "elm/browser": "1.0.0 <= v < 2.0.0", 15 | "elm/core": "1.0.0 <= v < 2.0.0", 16 | "elm/html": "1.0.0 <= v < 2.0.0", 17 | "elm/url": "1.0.0 <= v < 2.0.0" 18 | }, 19 | "test-dependencies": {} 20 | } -------------------------------------------------------------------------------- /examples/CmdM/Http.elm: -------------------------------------------------------------------------------- 1 | module CmdM.Http exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/http.html 9 | 10 | import Html exposing (..) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (..) 13 | import Http 14 | import Json.Decode as Decode 15 | 16 | import CmdM exposing (..) 17 | 18 | {-|-} 19 | main: CmdM.Program () Model Msg 20 | main = 21 | CmdM.element 22 | { init = \_ -> init "cats" 23 | , view = view 24 | , update = update 25 | , subscriptions = subscriptions 26 | } 27 | 28 | 29 | 30 | -- MODEL 31 | 32 | 33 | type alias Model = 34 | { topic : String 35 | , gifUrl : String 36 | } 37 | 38 | 39 | init : String -> (Model, CmdM Msg) 40 | init topic = 41 | ( Model topic "waiting.gif" 42 | , getRandomGif topic 43 | ) 44 | 45 | 46 | 47 | -- UPDATE 48 | 49 | 50 | type alias Msg = Result Http.Error String 51 | 52 | 53 | update : Msg -> Model -> (Model, CmdM Msg) 54 | update msg model = 55 | case msg of 56 | Ok newUrl -> 57 | (Model model.topic newUrl, CmdM.none) 58 | 59 | Err _ -> 60 | (model, CmdM.none) 61 | 62 | 63 | -- VIEW 64 | 65 | 66 | view : Model -> Html (CmdM Msg) 67 | view model = 68 | div [] 69 | [ h2 [] [text model.topic] 70 | -- The view can direcly trigger a command 71 | , button [ onClick (getRandomGif model.topic)] [ text "More Please!" ] 72 | , br [] [] 73 | , img [src model.gifUrl] [] 74 | ] 75 | 76 | 77 | 78 | -- SUBSCRIPTIONS 79 | 80 | 81 | subscriptions : Model -> Sub (CmdM Msg) 82 | subscriptions model = 83 | Sub.none 84 | 85 | 86 | 87 | -- HTTP 88 | 89 | 90 | getRandomGif : String -> CmdM Msg 91 | getRandomGif topic = 92 | let 93 | url = 94 | "https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic 95 | in 96 | CmdM.lift (Http.get { url = url 97 | , expect = Http.expectJson (\r -> r) decodeGifUrl 98 | } 99 | ) 100 | 101 | 102 | decodeGifUrl : Decode.Decoder String 103 | decodeGifUrl = 104 | Decode.at ["data", "image_url"] Decode.string 105 | -------------------------------------------------------------------------------- /examples/CmdM/Random.elm: -------------------------------------------------------------------------------- 1 | module CmdM.Random exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/random.html 9 | 10 | import Html exposing (..) 11 | import Html.Events exposing (..) 12 | import Random 13 | 14 | import CmdM exposing (..) 15 | 16 | {-|-} 17 | main: CmdM.Program () Model Msg 18 | main = 19 | CmdM.element 20 | { init = \_ -> init 21 | , view = view 22 | , update = update 23 | , subscriptions = subscriptions 24 | } 25 | 26 | -- MODEL 27 | 28 | type alias Model = { dieFace : Int } 29 | 30 | 31 | init : (Model, CmdM Msg) 32 | init = (Model 1, CmdM.none) 33 | 34 | -- UPDATE 35 | 36 | type Msg = NewFace Int 37 | 38 | roll : CmdM Msg 39 | roll = CmdM.lift (Random.generate NewFace (Random.int 1 6)) 40 | 41 | update : Msg -> Model -> (Model, CmdM Msg) 42 | update msg model = 43 | case msg of 44 | NewFace newFace -> 45 | (Model newFace, CmdM.none) 46 | 47 | 48 | -- SUBSCRIPTIONS 49 | 50 | subscriptions : Model -> Sub a 51 | subscriptions _ = Sub.none 52 | 53 | -- VIEW 54 | 55 | view : Model -> Html (CmdM Msg) 56 | view model = 57 | div [] 58 | [ h1 [] [ text (String.fromInt model.dieFace) ] 59 | , button [ onClick roll ] [ text "Roll" ] 60 | ] 61 | -------------------------------------------------------------------------------- /examples/IO/Batch.elm: -------------------------------------------------------------------------------- 1 | {- Example presenting the Batch Effect of IO -} 2 | module Batch exposing (..) 3 | 4 | import Html exposing (..) 5 | import Html.Events exposing(..) 6 | import Html.Attributes exposing(..) 7 | import IO exposing (..) 8 | import Task 9 | import Process 10 | import Time 11 | 12 | {- We do not need messages! Any type would 13 | be fine as messenges so we take the simplest 14 | one -} 15 | type alias Msg = () 16 | 17 | {- We need colored logs -} 18 | type alias Color = String 19 | 20 | {- This example is a logging application. 21 | Each item of the list is a logging line. -} 22 | type alias Model = List (Color, String) 23 | 24 | 25 | {- The Time.now task wrapped in IO -} 26 | now : IO model Time.Posix 27 | now = IO.lift (Task.perform identity Time.now) 28 | 29 | {- The Time.here task wrapped in IO -} 30 | here : IO model Time.Zone 31 | here = IO.lift (Task.perform identity Time.here) 32 | 33 | {- Prints one line of log with the provided color -} 34 | log : Color -> String -> IO Model Msg 35 | log color txt = 36 | here |> IO.andThen (\zone -> -- We get the current zone 37 | now |> IO.andThen (\posix -> -- and the current time 38 | let h = String.fromInt (Time.toHour zone posix) -- current hour 39 | m = String.fromInt (Time.toMinute zone posix) -- current minutes 40 | s = String.fromInt (Time.toSecond zone posix) -- current seconds 41 | ms = String.fromInt (Time.toMillis zone posix) -- current millis 42 | line = "[" ++ h ++ ":" ++ m ++ ":" ++ s ++ "." ++ ms ++ "] " ++ txt 43 | in IO.modify (\l -> l ++ [(color, line)]) -- add the line at the end of the list 44 | )) 45 | 46 | {- Prints each line of the logs -} 47 | view : Model -> Html (IO Model Msg) 48 | view m = 49 | div [] [ 50 | button [onClick (IO.set [] |> IO.seq test)] [text "Reset"], 51 | h1 [] [text "Logs"], 52 | ul [] (List.map (\(color,txt) -> li [style "color" color] [text txt]) m) 53 | ] 54 | 55 | {- Wait for duration milliseconds, then returns msg -} 56 | wait : Float -> msg -> IO model msg 57 | wait duration msg = 58 | IO.lift (Task.perform (\_ -> msg) (Process.sleep duration)) 59 | 60 | {- Simulates a task: 61 | - log the start of the task 62 | - do the task (simulated by waiting) 63 | - log the end of the task -} 64 | taskSimulation : (Color, Float, String) -> IO Model String 65 | taskSimulation (color, duration, msg) = 66 | log color (msg ++ " started") 67 | |> seq (wait duration msg 68 | |> IO.andThen (\r -> log color (msg ++ " finished") 69 | |> seq (pure r) 70 | ) 71 | ) 72 | 73 | {- The test -} 74 | test : IO Model Msg 75 | test = IO.batch [ -- We batch 5 tasks with different duration 76 | ("red" , 4000.0, "A"), 77 | ("green" , 2000.0, "B"), 78 | ("blue" , 5000.0, "C"), 79 | ("brown" , 3000.0, "D"), 80 | ("magenta" , 1000.0, "E") 81 | ] |> IO.andThen taskSimulation -- Run each task 82 | |> IO.andThen (\r -> log "black" ("Returns: " ++ r)) -- log the result 83 | 84 | main : IO.Program () Model Msg 85 | main = 86 | IO.sandbox { 87 | init = \_ -> ([], test), 88 | view = view, 89 | subscriptions = IO.dummySub 90 | } -------------------------------------------------------------------------------- /examples/IO/Buttons.elm: -------------------------------------------------------------------------------- 1 | module IO.Buttons exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/user_input/buttons.html 9 | 10 | import Html exposing (div, button, text, Html) 11 | import Html.Events exposing (onClick) 12 | 13 | import IO exposing (..) 14 | 15 | type alias Model = Int 16 | 17 | -- An empty type would mean no message at all! 18 | -- So we use unit at our dummy message type 19 | type alias Msg = () 20 | 21 | {-|-} 22 | main : IO.Program () Model Msg 23 | main = 24 | IO.sandbox { 25 | init = \_ -> (0, IO.none) , 26 | view = view, 27 | subscriptions = IO.dummySub 28 | } 29 | 30 | view : Int -> Html (IO Model Msg) 31 | view model = 32 | div [] 33 | [ button [ onClick decrement ] [ text "-" ] 34 | , div [] [ text (String.fromInt model) ] 35 | , button [ onClick increment ] [ text "+" ] 36 | ] 37 | 38 | increment : IO Model Msg 39 | increment = IO.modify (\x -> x + 1) 40 | 41 | decrement : IO Model Msg 42 | decrement = IO.modify (\x -> x - 1) -------------------------------------------------------------------------------- /examples/IO/CheckBoxes.elm: -------------------------------------------------------------------------------- 1 | module IO.CheckBoxes exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | import Html exposing (Html, fieldset, input, label, text) 8 | import Html.Attributes exposing (style, type_) 9 | import Html.Events exposing (onClick) 10 | 11 | import IO exposing (..) 12 | 13 | {-|-} 14 | main: IO.Program () Model Msg 15 | main = 16 | IO.sandbox { 17 | init = \_ -> (optOut, IO.none), 18 | view = view, 19 | subscriptions = IO.dummySub 20 | } 21 | 22 | 23 | -- MODEL 24 | 25 | 26 | type alias Model = 27 | { notifications : Bool 28 | , autoplay : Bool 29 | , location : Bool 30 | } 31 | 32 | 33 | optOut : Model 34 | optOut = 35 | Model True True True 36 | 37 | -- UPDATE 38 | 39 | type alias Msg = () 40 | 41 | toggleNotifications : IO Model Msg 42 | toggleNotifications = IO.modify (\model -> { model | notifications = not model.notifications } ) 43 | 44 | toggleAutoplay : IO Model Msg 45 | toggleAutoplay = IO.modify (\model -> { model | autoplay = not model.autoplay }) 46 | 47 | toggleLocation : IO Model Msg 48 | toggleLocation = IO.modify (\model -> { model | location = not model.location } ) 49 | 50 | -- VIEW 51 | 52 | 53 | view : Model -> Html (IO Model Msg) 54 | view model = 55 | fieldset [] 56 | [ checkbox toggleNotifications "Email Notifications" 57 | , checkbox toggleAutoplay "Video Autoplay" 58 | , checkbox toggleLocation "Use Location" 59 | ] 60 | 61 | 62 | checkbox : msg -> String -> Html msg 63 | checkbox msg name = 64 | label 65 | [ style "padding" "20px"] 66 | [ input [ type_ "checkbox", onClick msg ] [] 67 | , text name 68 | ] 69 | -------------------------------------------------------------------------------- /examples/IO/Field.elm: -------------------------------------------------------------------------------- 1 | module IO.Field exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read all about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/user_input/text_fields.html 9 | 10 | import Html exposing (Html, Attribute, text, div, input) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (onInput) 13 | import String 14 | 15 | import IO exposing (..) 16 | 17 | type alias Model = String 18 | type alias Msg = () 19 | 20 | {-|-} 21 | main : IO.Program () Model Msg 22 | main = 23 | IO.sandbox { 24 | init = \_ -> ("", IO.none), 25 | view = view, 26 | subscriptions = IO.dummySub 27 | } 28 | 29 | -- VIEW 30 | 31 | view : Model -> Html (IO Model Msg) 32 | view content = 33 | div [] 34 | [ input ([placeholder "Text to reverse", onInput IO.set] ++ myStyle) [] 35 | , div myStyle [ text (String.reverse content) ] 36 | ] 37 | 38 | myStyle = 39 | [ ("width", "100%") 40 | , ("height", "40px") 41 | , ("padding", "10px 0") 42 | , ("font-size", "2em") 43 | , ("text-align", "center") 44 | ] |> List.map (\(k,v) -> style k v) 45 | -------------------------------------------------------------------------------- /examples/IO/Form.elm: -------------------------------------------------------------------------------- 1 | module IO.Form exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | -- Read all about this program in the official Elm guide: 7 | -- https://guide.elm-lang.org/architecture/user_input/forms.html 8 | 9 | import Html exposing (..) 10 | import Html.Attributes exposing (..) 11 | import Html.Events exposing (onInput) 12 | 13 | import IO exposing (..) 14 | 15 | {-|-} 16 | main: IO.Program () Model Msg 17 | main = 18 | IO.sandbox 19 | { init = \_ -> (init, IO.none) 20 | , view = view 21 | , subscriptions = IO.dummySub 22 | } 23 | 24 | 25 | 26 | -- MODEL 27 | 28 | 29 | type alias Model = 30 | { name : String 31 | , password : String 32 | , passwordAgain : String 33 | } 34 | 35 | 36 | init : Model 37 | init = 38 | Model "" "" "" 39 | 40 | 41 | 42 | -- UPDATE 43 | 44 | type alias Msg = () 45 | 46 | name : String -> IO Model Msg 47 | name nm = IO.modify (\model -> { model | name = nm }) 48 | 49 | password : String -> IO Model Msg 50 | password passwd = IO.modify (\model -> { model | password = passwd }) 51 | 52 | passwordAgain : String -> IO Model Msg 53 | passwordAgain passwd = IO.modify (\model -> { model | passwordAgain = passwd }) 54 | 55 | 56 | -- VIEW 57 | 58 | 59 | view : Model -> Html (IO Model Msg) 60 | view model = 61 | div [] 62 | [ input [ type_ "text", placeholder "Name", onInput name ] [] 63 | , input [ type_ "password", placeholder "Password", onInput password ] [] 64 | , input [ type_ "password", placeholder "Re-enter Password", onInput passwordAgain ] [] 65 | , viewValidation model 66 | ] 67 | 68 | 69 | viewValidation : Model -> Html msg 70 | viewValidation model = 71 | let 72 | (color, message) = 73 | if model.password == model.passwordAgain then 74 | ("green", "OK") 75 | else 76 | ("red", "Passwords do not match!") 77 | in 78 | div [style "color" color] [ text message ] 79 | -------------------------------------------------------------------------------- /examples/IO/Hello.elm: -------------------------------------------------------------------------------- 1 | module Hello exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Events exposing(..) 5 | import IO exposing (..) 6 | 7 | type alias Model = Int 8 | type alias Msg = () 9 | 10 | increment : IO Model Msg 11 | increment = IO.modify ((+) 1) 12 | 13 | reset : IO Model Msg 14 | reset = IO.set 0 15 | 16 | view : Model -> Html (IO Model Msg) 17 | view m = 18 | div [] [ 19 | h1 [] [text "Example of an IO program"], 20 | p [] [text ("Counter = " ++ (String.fromInt m))], 21 | button [onClick increment] [text "increment"], 22 | button [onClick reset] [text "reset"] 23 | ] 24 | 25 | main : IO.Program () Model Msg 26 | main = 27 | IO.sandbox { 28 | init = \_ -> (0, IO.none), 29 | view = view , 30 | subscriptions = IO.dummySub 31 | } 32 | -------------------------------------------------------------------------------- /examples/IO/Http.elm: -------------------------------------------------------------------------------- 1 | module IO.Http exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/http.html 9 | 10 | import Html exposing (..) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (..) 13 | import Http 14 | import Json.Decode as Decode 15 | 16 | import IO exposing (..) 17 | 18 | {-|-} 19 | main: IO.Program () Model Msg 20 | main = 21 | IO.sandbox 22 | { init = \_ -> init "cats" 23 | , view = view 24 | , subscriptions = IO.dummySub 25 | } 26 | 27 | 28 | 29 | -- MODEL 30 | 31 | 32 | type alias Model = 33 | { topic : String 34 | , gifUrl : String 35 | } 36 | 37 | init : String -> (Model, IO Model Msg) 38 | init topic = ( Model topic "waiting.gif" , getRandomGif) 39 | 40 | 41 | 42 | -- UPDATE 43 | 44 | type alias Msg = () 45 | 46 | -- VIEW 47 | 48 | 49 | view : Model -> Html (IO Model Msg) 50 | view model = 51 | div [] 52 | [ h2 [] [text model.topic] 53 | , button [ onClick getRandomGif ] [ text "More Please!" ] 54 | , br [] [] 55 | , img [src model.gifUrl] [] 56 | ] 57 | 58 | -- HTTP 59 | 60 | getRandomGif : IO Model Msg 61 | getRandomGif = 62 | IO.get |> IO.andThen (\model -> 63 | let 64 | topic = model.topic 65 | url = "https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic 66 | in 67 | IO.lift (Http.get { url = url 68 | , expect = Http.expectJson (\r -> r) decodeGifUrl 69 | } 70 | ) |> IO.andThen (\response -> 71 | case response of 72 | Ok newUrl -> IO.set (Model topic newUrl) 73 | Err _ -> IO.none 74 | )) 75 | 76 | decodeGifUrl : Decode.Decoder String 77 | decodeGifUrl = 78 | Decode.at ["data", "image_url"] Decode.string -------------------------------------------------------------------------------- /examples/IO/InfiniteLog.elm: -------------------------------------------------------------------------------- 1 | {- Example presenting the Batch Effect of IO -} 2 | module Test exposing (..) 3 | 4 | import Html exposing (..) 5 | import Html.Events exposing(..) 6 | import Html.Attributes exposing(..) 7 | import IO exposing (..) 8 | 9 | type alias Msg = () 10 | type alias Model = List String 11 | 12 | {- Add one string to the logs, 9 lines of lines at maximum (older removed) -} 13 | log : String -> IO Model Msg 14 | log txt = IO.modify (\l -> txt :: (List.take 9 l)) 15 | 16 | {- Prints each line of the logs -} 17 | view : Model -> Html Msg 18 | view m = 19 | div [] [ 20 | h1 [] [text "Logs"], 21 | ul [] (List.map (\txt -> li [] [text txt]) m) 22 | ] 23 | 24 | {- Recursive function logging indefinitely -} 25 | test : Int -> IO Model Msg 26 | test n = log (String.fromInt n) 27 | |> IO.andThen IO.yield 28 | |> IO.andThen (\_ -> test (n + 1)) 29 | 30 | main : IO.Program () Model Msg 31 | main = 32 | IO.sandbox { 33 | init = \_ -> ([], test 0), 34 | view = view >> Html.map IO.pure, 35 | subscriptions = IO.dummySub 36 | } -------------------------------------------------------------------------------- /examples/IO/RadioButtons.elm: -------------------------------------------------------------------------------- 1 | module IO.RadioButtons exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | import Html exposing (Html, Attribute, div, fieldset, input, label, text) 8 | import Html.Attributes exposing (name, style, type_) 9 | import Html.Events exposing (onClick) 10 | import Markdown 11 | 12 | import IO exposing (..) 13 | 14 | {-|-} 15 | main: IO.Program () Model Msg 16 | main = 17 | IO.sandbox { 18 | init = \_ -> (chapter1, IO.none), 19 | view = view, 20 | subscriptions = IO.dummySub 21 | } 22 | 23 | -- MODEL 24 | 25 | 26 | type alias Model = 27 | { fontSize : FontSize 28 | , content : String 29 | } 30 | 31 | 32 | type FontSize 33 | = Small 34 | | Medium 35 | | Large 36 | 37 | 38 | chapter1 : Model 39 | chapter1 = 40 | Model Medium intro 41 | 42 | 43 | intro : String 44 | intro = """ 45 | 46 | # Anna Karenina 47 | 48 | ## Chapter 1 49 | 50 | Happy families are all alike; every unhappy family is unhappy in its own way. 51 | 52 | Everything was in confusion in the Oblonskys’ house. The wife had discovered 53 | that the husband was carrying on an intrigue with a French girl, who had been 54 | a governess in their family, and she had announced to her husband that she 55 | could not go on living in the same house with him... 56 | 57 | """ 58 | 59 | 60 | 61 | -- UPDATE 62 | 63 | 64 | type alias Msg = () 65 | 66 | switchTo : FontSize -> IO Model Msg 67 | switchTo newFontSize = IO.modify (\model -> { model | fontSize = newFontSize }) 68 | 69 | -- VIEW 70 | 71 | 72 | view : Model -> Html (IO Model Msg) 73 | view model = 74 | div [] 75 | [ fieldset [] 76 | [ radio "Small" (switchTo Small) 77 | , radio "Medium" (switchTo Medium) 78 | , radio "Large" (switchTo Large) 79 | ] 80 | , Markdown.toHtml [ sizeToStyle model.fontSize ] model.content 81 | ] 82 | 83 | 84 | radio : String -> msg -> Html msg 85 | radio value msg = 86 | label 87 | [ style "padding" "20px"] 88 | [ input [ type_ "radio", name "font-size", onClick msg ] [] 89 | , text value 90 | ] 91 | 92 | 93 | sizeToStyle : FontSize -> Attribute msg 94 | sizeToStyle fontSize = 95 | let 96 | size = 97 | case fontSize of 98 | Small -> "0.8em" 99 | Medium -> "1em" 100 | Large -> "1.2em" 101 | in style "font-size" size 102 | -------------------------------------------------------------------------------- /examples/IO/Random.elm: -------------------------------------------------------------------------------- 1 | module IO.Random exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/random.html 9 | 10 | import Html exposing (..) 11 | import Html.Events exposing (..) 12 | import Random 13 | 14 | import IO exposing (..) 15 | 16 | {-|-} 17 | main: IO.Program () Model Msg 18 | main = 19 | IO.sandbox 20 | { init = \_ -> (init, IO.none) 21 | , view = view 22 | , subscriptions = IO.dummySub 23 | } 24 | 25 | 26 | -- MODEL 27 | 28 | 29 | type alias Model = { dieFace : Int } 30 | 31 | init : Model 32 | init = Model 1 33 | 34 | -- UPDATE 35 | 36 | 37 | type alias Msg = () 38 | 39 | roll : IO Model Msg 40 | roll = 41 | IO.lift (Random.generate identity (Random.int 1 6)) |> IO.andThen ( 42 | \newFace -> IO.set (Model newFace) 43 | ) 44 | 45 | -- VIEW 46 | 47 | 48 | view : Model -> Html (IO Model Msg) 49 | view model = 50 | div [] 51 | [ h1 [] [ text (String.fromInt model.dieFace) ] 52 | , button [ onClick roll ] [ text "Roll" ] 53 | ] -------------------------------------------------------------------------------- /examples/IO/Time.elm: -------------------------------------------------------------------------------- 1 | module IO.Time exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/time.html 9 | 10 | import Html exposing (Html) 11 | import Svg exposing (..) 12 | import Svg.Attributes exposing (..) 13 | import Time 14 | 15 | import IO exposing (..) 16 | 17 | {-|-} 18 | main: IO.Program () Model Msg 19 | main = 20 | IO.sandbox 21 | { init = \_ -> (init, IO.none) 22 | , view = view 23 | , subscriptions = subscriptions 24 | } 25 | 26 | -- MODEL 27 | 28 | 29 | type alias Model = Time.Posix 30 | 31 | init : Model 32 | init = Time.millisToPosix 0 33 | 34 | 35 | -- UPDATE 36 | 37 | type alias Msg = () 38 | 39 | -- SUBSCRIPTIONS 40 | 41 | subscriptions : Model -> Sub (IO Model Msg) 42 | subscriptions model = 43 | Time.every 1000 IO.set 44 | 45 | 46 | -- VIEW 47 | 48 | view : Model -> Html a 49 | view model = 50 | let angle = turns ((toFloat (Time.posixToMillis model)) / 36000) 51 | handX = String.fromFloat (50 + 40 * cos angle) 52 | handY = String.fromFloat (50 + 40 * sin angle) 53 | in svg [ viewBox "0 0 100 100", width "300px" ] 54 | [ circle [ cx "50", cy "50", r "45", fill "#0B79CE" ] [] 55 | , line [ x1 "50", y1 "50", x2 handX, y2 handY, stroke "#023963" ] [] 56 | ] 57 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | # Usage: 2 | # make # compile all binary 3 | # make clean # remove ALL binaries and objects 4 | 5 | .PHONY = all clean 6 | 7 | ELM = elm # compiler to use 8 | 9 | SRCS := $(wildcard */*.elm) 10 | BINS := $(SRCS:%.elm=%.html) 11 | 12 | all: ${BINS} 13 | 14 | %.html: %.elm 15 | ${ELM} make $< --output=$@ 16 | 17 | clean: 18 | @echo "Cleaning up..." 19 | rm -rvf elm-stuff/ ${BINS} 20 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | # Examples from http://elm-lang.org/examples transated into [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) and [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) 2 | 3 | The [TEA](https://github.com/chrilves/elm-io/tree/master/examples/TEA) folder contains original examples from http://elm-lang.org/examples. Their [CmdM](http://package.elm-lang.org/packages/chrilves/elm-io/latest/CmdM) counterparts are located into the [CmdM](https://github.com/chrilves/elm-io/tree/master/examples/CmdM) folder and their [IO](http://package.elm-lang.org/packages/chrilves/elm-io/latest/IO) ones in the [IO](https://github.com/chrilves/elm-io/tree/master/examples/IO) folder. 4 | 5 | # Running 6 | 7 | From the [example](https://github.com/chrilves/elm-io/tree/master/examples) directory, just type: 8 | 9 | ```sh 10 | elm reactor 11 | ``` 12 | 13 | and visit http://localhost:8000/ 14 | 15 | # Running via Make 16 | 17 | Alternatively, you can compile the examples via make. From the [example](https://github.com/chrilves/elm-io/tree/master/examples) directory, just type: 18 | 19 | ```sh 20 | make 21 | ``` 22 | 23 | and load the HTML files in a browser. -------------------------------------------------------------------------------- /examples/TEA/Buttons.elm: -------------------------------------------------------------------------------- 1 | module TEA.Buttons exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/user_input/buttons.html 9 | 10 | import Html exposing (div, button, text) 11 | import Html.Events exposing (onClick) 12 | import Browser 13 | 14 | {-|-} 15 | main: Program () Int Msg 16 | main = 17 | Browser.sandbox { init = 0, view = view, update = update } 18 | 19 | 20 | view model = 21 | div [] 22 | [ button [ onClick Decrement ] [ text "-" ] 23 | , div [] [ text (String.fromInt model) ] 24 | , button [ onClick Increment ] [ text "+" ] 25 | ] 26 | 27 | 28 | type Msg = Increment | Decrement 29 | 30 | 31 | update msg model = 32 | case msg of 33 | Increment -> 34 | model + 1 35 | 36 | Decrement -> 37 | model - 1 -------------------------------------------------------------------------------- /examples/TEA/CheckBoxes.elm: -------------------------------------------------------------------------------- 1 | module TEA.CheckBoxes exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | import Html exposing (Html, fieldset, input, label, text) 8 | import Html.Attributes exposing (style, type_) 9 | import Html.Events exposing (onClick) 10 | import Browser 11 | 12 | 13 | {-|-} 14 | main: Program () Model Msg 15 | main = 16 | Browser.sandbox { init = optOut, update = update, view = view } 17 | 18 | -- MODEL 19 | type alias Model = 20 | { notifications : Bool 21 | , autoplay : Bool 22 | , location : Bool 23 | } 24 | 25 | 26 | optOut : Model 27 | optOut = Model True True True 28 | 29 | -- UPDATE 30 | 31 | type Msg 32 | = ToggleNotifications 33 | | ToggleAutoplay 34 | | ToggleLocation 35 | 36 | 37 | update : Msg -> Model -> Model 38 | update msg model = 39 | case msg of 40 | ToggleNotifications -> 41 | { model | notifications = not model.notifications } 42 | 43 | ToggleAutoplay -> 44 | { model | autoplay = not model.autoplay } 45 | 46 | ToggleLocation -> 47 | { model | location = not model.location } 48 | 49 | -- VIEW 50 | 51 | view : Model -> Html Msg 52 | view model = 53 | fieldset [] 54 | [ checkbox ToggleNotifications "Email Notifications" 55 | , checkbox ToggleAutoplay "Video Autoplay" 56 | , checkbox ToggleLocation "Use Location" 57 | ] 58 | 59 | checkbox : msg -> String -> Html msg 60 | checkbox msg name = 61 | label 62 | [ style "padding" "20px"] 63 | [ input [ type_ "checkbox", onClick msg ] [] 64 | , text name 65 | ] 66 | -------------------------------------------------------------------------------- /examples/TEA/Field.elm: -------------------------------------------------------------------------------- 1 | module TEA.Field exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read all about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/user_input/text_fields.html 9 | 10 | import Html exposing (Html, Attribute, text, div, input) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (onInput) 13 | import String 14 | import Browser 15 | 16 | {-|-} 17 | main: Program () String Msg 18 | main = 19 | Browser.sandbox { init = "", view = view, update = update } 20 | 21 | 22 | -- UPDATE 23 | 24 | type Msg = NewContent String 25 | 26 | update (NewContent content) oldContent = 27 | content 28 | 29 | 30 | -- VIEW 31 | 32 | view content = 33 | div [] 34 | [ input ([ placeholder "Text to reverse", onInput NewContent] ++ myStyle) [] 35 | , div myStyle [ text (String.reverse content) ] 36 | ] 37 | 38 | myStyle = 39 | [ ("width", "100%") 40 | , ("height", "40px") 41 | , ("padding", "10px 0") 42 | , ("font-size", "2em") 43 | , ("text-align", "center") 44 | ] |> List.map (\(k,v) -> style k v) 45 | -------------------------------------------------------------------------------- /examples/TEA/Form.elm: -------------------------------------------------------------------------------- 1 | module TEA.Form exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read all about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/user_input/forms.html 9 | 10 | import Html exposing (..) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (onInput) 13 | import Browser 14 | 15 | {-|-} 16 | main: Program () Model Msg 17 | main = 18 | Browser.sandbox 19 | { init = init 20 | , view = view 21 | , update = update 22 | } 23 | 24 | 25 | 26 | -- MODEL 27 | 28 | 29 | type alias Model = 30 | { name : String 31 | , password : String 32 | , passwordAgain : String 33 | } 34 | 35 | 36 | init : Model 37 | init = Model "" "" "" 38 | 39 | -- UPDATE 40 | 41 | 42 | type Msg 43 | = Name String 44 | | Password String 45 | | PasswordAgain String 46 | 47 | 48 | update : Msg -> Model -> Model 49 | update msg model = 50 | case msg of 51 | Name name -> 52 | { model | name = name } 53 | 54 | Password password -> 55 | { model | password = password } 56 | 57 | PasswordAgain password -> 58 | { model | passwordAgain = password } 59 | 60 | 61 | 62 | -- VIEW 63 | 64 | 65 | view : Model -> Html Msg 66 | view model = 67 | div [] 68 | [ input [ type_ "text", placeholder "Name", onInput Name ] [] 69 | , input [ type_ "password", placeholder "Password", onInput Password ] [] 70 | , input [ type_ "password", placeholder "Re-enter Password", onInput PasswordAgain ] [] 71 | , viewValidation model 72 | ] 73 | 74 | 75 | viewValidation : Model -> Html msg 76 | viewValidation model = 77 | let 78 | (color, message) = 79 | if model.password == model.passwordAgain then 80 | ("green", "OK") 81 | else 82 | ("red", "Passwords do not match!") 83 | in 84 | div [style "color" color] [ text message ] 85 | -------------------------------------------------------------------------------- /examples/TEA/Http.elm: -------------------------------------------------------------------------------- 1 | module TEA.Http exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/http.html 9 | 10 | import Html exposing (..) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (..) 13 | import Http 14 | import Json.Decode as Decode 15 | import Browser 16 | 17 | 18 | {-|-} 19 | main: Program () Model Msg 20 | main = 21 | Browser.element 22 | { init = \_ -> init "cats" 23 | , view = view 24 | , update = update 25 | , subscriptions = subscriptions 26 | } 27 | 28 | -- MODEL 29 | 30 | type alias Model = 31 | { topic : String 32 | , gifUrl : String 33 | } 34 | 35 | 36 | init : String -> (Model, Cmd Msg) 37 | init topic = 38 | ( Model topic "waiting.gif" 39 | , getRandomGif topic 40 | ) 41 | 42 | 43 | 44 | -- UPDATE 45 | 46 | 47 | type Msg 48 | = MorePlease 49 | | NewGif (Result Http.Error String) 50 | 51 | 52 | update : Msg -> Model -> (Model, Cmd Msg) 53 | update msg model = 54 | case msg of 55 | MorePlease -> 56 | (model, getRandomGif model.topic) 57 | 58 | NewGif (Ok newUrl) -> 59 | (Model model.topic newUrl, Cmd.none) 60 | 61 | NewGif (Err _) -> 62 | (model, Cmd.none) 63 | 64 | 65 | 66 | -- VIEW 67 | 68 | 69 | view : Model -> Html Msg 70 | view model = 71 | div [] 72 | [ h2 [] [text model.topic] 73 | , button [ onClick MorePlease ] [ text "More Please!" ] 74 | , br [] [] 75 | , img [src model.gifUrl] [] 76 | ] 77 | 78 | 79 | 80 | -- SUBSCRIPTIONS 81 | 82 | 83 | subscriptions : Model -> Sub Msg 84 | subscriptions model = 85 | Sub.none 86 | 87 | 88 | 89 | -- HTTP 90 | 91 | 92 | getRandomGif : String -> Cmd Msg 93 | getRandomGif topic = 94 | let 95 | url = 96 | "https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic 97 | in Http.get { url = url 98 | , expect = Http.expectJson NewGif decodeGifUrl 99 | } 100 | 101 | 102 | decodeGifUrl : Decode.Decoder String 103 | decodeGifUrl = 104 | Decode.at ["data", "image_url"] Decode.string 105 | -------------------------------------------------------------------------------- /examples/TEA/RadioButtons.elm: -------------------------------------------------------------------------------- 1 | module TEA.RadioButtons exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | import Html exposing (Html, Attribute, div, fieldset, input, label, text) 8 | import Html.Attributes exposing (name, style, type_) 9 | import Html.Events exposing (onClick) 10 | import Markdown 11 | import Browser 12 | 13 | 14 | {-|-} 15 | main: Program () Model Msg 16 | main = 17 | Browser.sandbox { init = chapter1, update = update, view = view } 18 | 19 | 20 | 21 | -- MODEL 22 | 23 | 24 | type alias Model = 25 | { fontSize : FontSize 26 | , content : String 27 | } 28 | 29 | 30 | type FontSize 31 | = Small 32 | | Medium 33 | | Large 34 | 35 | 36 | chapter1 : Model 37 | chapter1 = 38 | Model Medium intro 39 | 40 | 41 | intro : String 42 | intro = """ 43 | 44 | # Anna Karenina 45 | 46 | ## Chapter 1 47 | 48 | Happy families are all alike; every unhappy family is unhappy in its own way. 49 | 50 | Everything was in confusion in the Oblonskys’ house. The wife had discovered 51 | that the husband was carrying on an intrigue with a French girl, who had been 52 | a governess in their family, and she had announced to her husband that she 53 | could not go on living in the same house with him... 54 | 55 | """ 56 | 57 | 58 | 59 | -- UPDATE 60 | 61 | 62 | type Msg 63 | = SwitchTo FontSize 64 | 65 | 66 | update : Msg -> Model -> Model 67 | update msg model = 68 | case msg of 69 | SwitchTo newFontSize -> 70 | { model | fontSize = newFontSize } 71 | 72 | 73 | 74 | -- VIEW 75 | 76 | 77 | view : Model -> Html Msg 78 | view model = 79 | div [] 80 | [ fieldset [] 81 | [ radio "Small" (SwitchTo Small) 82 | , radio "Medium" (SwitchTo Medium) 83 | , radio "Large" (SwitchTo Large) 84 | ] 85 | , Markdown.toHtml [ sizeToStyle model.fontSize ] model.content 86 | ] 87 | 88 | 89 | radio : String -> msg -> Html msg 90 | radio value msg = 91 | label 92 | [style "padding" "20px"] 93 | [ input [ type_ "radio", name "font-size", onClick msg ] [] 94 | , text value 95 | ] 96 | 97 | 98 | sizeToStyle : FontSize -> Attribute msg 99 | sizeToStyle fontSize = 100 | let size = 101 | case fontSize of 102 | Small -> "0.8em" 103 | Medium -> "1em" 104 | Large -> "1.2em" 105 | in style "font-size" size 106 | -------------------------------------------------------------------------------- /examples/TEA/Random.elm: -------------------------------------------------------------------------------- 1 | module TEA.Random exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/random.html 9 | 10 | import Html exposing (..) 11 | import Html.Events exposing (..) 12 | import Random 13 | import Browser 14 | 15 | 16 | {-|-} 17 | main: Program () Model Msg 18 | main = 19 | Browser.element 20 | { init = \_ -> init 21 | , view = view 22 | , update = update 23 | , subscriptions = subscriptions 24 | } 25 | 26 | 27 | 28 | -- MODEL 29 | 30 | 31 | type alias Model = 32 | { dieFace : Int 33 | } 34 | 35 | 36 | init : (Model, Cmd Msg) 37 | init = 38 | (Model 1, Cmd.none) 39 | 40 | 41 | 42 | -- UPDATE 43 | 44 | 45 | type Msg 46 | = Roll 47 | | NewFace Int 48 | 49 | 50 | update : Msg -> Model -> (Model, Cmd Msg) 51 | update msg model = 52 | case msg of 53 | Roll -> 54 | (model, Random.generate NewFace (Random.int 1 6)) 55 | 56 | NewFace newFace -> 57 | (Model newFace, Cmd.none) 58 | 59 | 60 | 61 | -- SUBSCRIPTIONS 62 | 63 | 64 | subscriptions : Model -> Sub Msg 65 | subscriptions model = 66 | Sub.none 67 | 68 | 69 | 70 | -- VIEW 71 | 72 | 73 | view : Model -> Html Msg 74 | view model = 75 | div [] 76 | [ h1 [] [ text (String.fromInt model.dieFace) ] 77 | , button [ onClick Roll ] [ text "Roll" ] 78 | ] 79 | -------------------------------------------------------------------------------- /examples/TEA/Time.elm: -------------------------------------------------------------------------------- 1 | module TEA.Time exposing (main) 2 | 3 | {-| 4 | @docs main 5 | -} 6 | 7 | -- Read more about this program in the official Elm guide: 8 | -- https://guide.elm-lang.org/architecture/effects/time.html 9 | 10 | import Html exposing (Html) 11 | import Svg exposing (..) 12 | import Svg.Attributes exposing (..) 13 | import Time 14 | import Browser 15 | 16 | {-|-} 17 | main: Program () Model Msg 18 | main = 19 | Browser.element 20 | { init = \_ -> init 21 | , view = view 22 | , update = update 23 | , subscriptions = subscriptions 24 | } 25 | 26 | -- MODEL 27 | 28 | type alias Model = Time.Posix 29 | 30 | init : (Model, Cmd Msg) 31 | init = (Time.millisToPosix 0, Cmd.none) 32 | 33 | -- UPDATE 34 | 35 | type Msg = Tick Time.Posix 36 | 37 | update : Msg -> Model -> (Model, Cmd Msg) 38 | update msg model = 39 | case msg of 40 | Tick newTime -> 41 | (newTime, Cmd.none) 42 | 43 | -- SUBSCRIPTIONS 44 | 45 | subscriptions : Model -> Sub Msg 46 | subscriptions model = 47 | Time.every 1000 Tick 48 | 49 | -- VIEW 50 | 51 | view : Model -> Html Msg 52 | view model = 53 | let 54 | angle = turns ((toFloat (Time.posixToMillis model)) / 36000) 55 | handX = String.fromFloat (50 + 40 * cos angle) 56 | handY = String.fromFloat (50 + 40 * sin angle) 57 | in svg [ viewBox "0 0 100 100", width "300px" ] 58 | [ circle [ cx "50", cy "50", r "45", fill "#0B79CE" ] [] 59 | , line [ x1 "50", y1 "50", x2 handX, y2 handY, stroke "#023963" ] [] 60 | ] 61 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "../src", 5 | "." 6 | ], 7 | "elm-version": "0.19.0", 8 | "dependencies": { 9 | "direct": { 10 | "arturopala/elm-monocle": "2.1.0", 11 | "elm/browser": "1.0.1", 12 | "elm/core": "1.0.2", 13 | "elm/html": "1.0.0", 14 | "elm/http": "2.0.0", 15 | "elm/json": "1.1.3", 16 | "elm/random": "1.0.0", 17 | "elm/svg": "1.0.1", 18 | "elm/time": "1.0.0", 19 | "elm/url": "1.0.0", 20 | "elm-explorations/markdown": "1.0.0" 21 | }, 22 | "indirect": { 23 | "elm/bytes": "1.0.8", 24 | "elm/file": "1.0.4", 25 | "elm/virtual-dom": "1.0.2" 26 | } 27 | }, 28 | "test-dependencies": { 29 | "direct": {}, 30 | "indirect": {} 31 | } 32 | } -------------------------------------------------------------------------------- /src/CmdM.elm: -------------------------------------------------------------------------------- 1 | module CmdM exposing 2 | ( CmdM 3 | , Program, element, document, application 4 | , pure, lift, none 5 | , map, andThen, join, ap, flap, compose, seq, traverse, mapM 6 | , transform 7 | , batch, batchM 8 | ) 9 | 10 | 11 | {-| This module provides a monadic interface for commands. 12 | 13 | Basically [CmdM](#CmdM) is like `Cmd` but is a monad, which means 14 | you can chain effects as you like! 15 | 16 | @docs CmdM 17 | 18 | 19 | # Runing an Elm application with [CmdM](#CmdM) 20 | 21 | This module port the four main way of running an Elm application to [CmdM](#CmdM). 22 | 23 | @docs Program, element, document, application 24 | 25 | 26 | # Lifting values and commands into [CmdM](#CmdM) 27 | 28 | @docs pure, lift, none 29 | 30 | 31 | # Classic monadic operations 32 | 33 | @docs map, andThen, join, ap, flap, compose, seq, traverse, mapM 34 | 35 | # Transform CmdM into regular Elm 36 | 37 | @docs transform 38 | 39 | 40 | # Batch operations 41 | 42 | Beware that batch operations might not do what you think. The execution order of 43 | messages and commands is **not defined**. 44 | 45 | @docs batch, batchM 46 | 47 | -} 48 | 49 | import Browser exposing (..) 50 | import Browser.Navigation exposing (Key) 51 | import CmdM.Internal exposing (..) 52 | import Html exposing (Html) 53 | import Platform.Cmd exposing (..) 54 | import Url exposing (..) 55 | 56 | {-| Monadic interface for commands. 57 | 58 | A value of type `CmdM msg` is an effectful 59 | computation that can perform commands and 60 | contains values of type `msg`. 61 | 62 | -} 63 | type alias CmdM msg = 64 | CmdM.Internal.CmdM msg 65 | 66 | -- Monadic 67 | 68 | {-| Returns a [CmdM](#CmdM) whose only effect is containing the value given to [pure](#pure). 69 | -} 70 | pure : a -> CmdM a 71 | pure a = Pure a 72 | 73 | {-| Send messages in batch 74 | -} 75 | batch : List a -> CmdM a 76 | batch l = Impure (Batch (List.map Pure l)) 77 | 78 | 79 | {-| Transforms an Elm command into a monadic command [CmdM](#CmdM). 80 | -} 81 | lift : Cmd a -> CmdM a 82 | lift cmd = Impure (Command (Cmd.map Pure cmd)) 83 | 84 | 85 | {-| Map a function over an [CmdM](#CmdM). 86 | 87 | **Laws** 88 | 89 | - `map (f >> g) = (map f) >> (map g)` 90 | - `map identity = identity` 91 | 92 | -} 93 | map : (a -> b) -> CmdM a -> CmdM b 94 | map f = 95 | let aux cmdm = 96 | case cmdm of 97 | Pure a -> Pure (f a) 98 | Impure m -> Impure (effectMap aux m) 99 | in aux 100 | 101 | 102 | {-| Chains [CmdM](#CmdM)s. 103 | 104 | If you have a `CmdM a` and a function which given 105 | a `a` can give you a `CmdM b` depending on the value 106 | of type `a` given to the function. Then [andThen](#andThen) gives you 107 | a `CmdM b` that will run the first [CmdM](#CmdM) and then apply 108 | the function. 109 | 110 | **Laws** 111 | 112 | - `andThen pure = identity` 113 | - `andThen (f >> pure) = map f` 114 | - `(andThen f) >> (andThen g) = andThen (a -> andThen g (f a))` 115 | 116 | -} 117 | andThen : (a -> CmdM b) -> CmdM a -> CmdM b 118 | andThen f = 119 | let aux m = 120 | case m of 121 | Pure a -> f a 122 | Impure x -> Impure (effectMap aux x) 123 | in aux 124 | 125 | 126 | {-| Flatten a [CmdM](#CmdM) containing a [CmdM](#CmdM) into a simple [CmdM](#CmdM). 127 | 128 | **Laws** 129 | 130 | - `join (pure m) = m` 131 | 132 | -} 133 | join : CmdM (CmdM a) -> CmdM a 134 | join = andThen identity 135 | 136 | 137 | {-| Transform a [CmdM](#CmdM) containing functions into functions on [CmdM](#CmdM). 138 | It enable to easily lift functions to [CmdM](#CmdM). 139 | 140 | **Laws** 141 | 142 | - `ap (pure identity) = identity` 143 | - `ap (pure (f >> g)) = ap (pure f) >> ap (pure g)` 144 | 145 | -} 146 | ap : CmdM (a -> b) -> CmdM a -> CmdM b 147 | ap mf ma = mf |> andThen (\f -> map f ma) 148 | 149 | {-| Flipped version of ap. To be used like: 150 | 151 | pure f |> flap arg1 |> flap arg2 ... 152 | -} 153 | flap : CmdM a -> CmdM (a -> b) -> CmdM b 154 | flap ma mf = ap mf ma 155 | 156 | {-| Composition of monadic functions 157 | -} 158 | compose : (b -> CmdM c) -> (a -> CmdM b) -> a -> CmdM c 159 | compose g f a = f a |> andThen g 160 | 161 | {-| Run the second argument, ignore the result, then run the first one. 162 | To be used in 163 | 164 | first |> seq second 165 | -} 166 | seq : CmdM b -> CmdM a -> CmdM b 167 | seq second first = first |> andThen (\_ -> second) 168 | 169 | -- Monoid 170 | 171 | {-| A [CmdM](#CmdM) doing nothing (an containing no values!). 172 | -} 173 | none : CmdM a 174 | none = batch [] 175 | 176 | 177 | {-| **I strongly discourage you from using it. Use [mapM](#mapM) instead.** 178 | Group commands in a batch. Its behavior may not be what you expect! 179 | -} 180 | batchM : List (CmdM a) -> CmdM a 181 | batchM l = join (batch l) 182 | 183 | {-| You can think of traverse like a [map](#map) but with effects. 184 | It maps a function performing [CmdM](#CmdM) effects over a list. 185 | -} 186 | traverse : (a -> CmdM b) -> List a -> CmdM (List b) 187 | traverse f l = 188 | case l of 189 | [] -> pure [] 190 | hd :: tl -> ap (ap (pure (::)) (f hd)) (traverse f tl) 191 | 192 | {-| Transform a list of [CmdM](#CmdM) into an [CmdM](#CmdM) of list. 193 | -} 194 | mapM : List (CmdM a) -> CmdM (List a) 195 | mapM = traverse identity 196 | 197 | -- Platform 198 | 199 | {-| Program using [CmdM](#CmdM). 200 | -} 201 | type alias Program flags model msg = 202 | Platform.Program flags model (CmdM msg) 203 | 204 | -- The core of all the [CmdM](#CmdM) monad! It runs the [CmdM](#CmdM) monad using the update function. 205 | 206 | runUpdate : (msg -> model -> ( model, CmdM msg )) -> CmdM msg -> model -> ( model, Cmd (CmdM msg) ) 207 | runUpdate f = 208 | let 209 | aux : CmdM msg -> model -> ( model, Cmd (CmdM msg) ) 210 | aux cmdm model = 211 | case cmdm of 212 | Pure msg -> let (model2, cmdm2) = f msg model 213 | in aux cmdm2 model2 214 | Impure (Command cmd) -> (model, cmd) 215 | Impure (Batch l) -> 216 | let (modelEnd, cmdsEnd) = 217 | List.foldl (\cmdm2 (modelAcc, cmdsAcc) -> 218 | let (m3, cs3) = aux cmdm2 modelAcc 219 | in (m3, cs3 :: cmdsAcc) 220 | ) (model, []) l 221 | in (modelEnd, Cmd.batch cmdsEnd) 222 | in aux 223 | 224 | 225 | {-| Transform a program using [CmdM](#CmdM) into a normal program. 226 | -} 227 | transform : 228 | (msg -> model -> ( model, CmdM msg )) 229 | -> 230 | { update : CmdM msg -> model -> ( model, Cmd (CmdM msg) ) 231 | , initTransformer : ( model, CmdM msg ) -> ( model, Cmd (CmdM msg) ) 232 | } 233 | transform update = 234 | let 235 | newUpdate = 236 | runUpdate update 237 | in 238 | { update = newUpdate 239 | , initTransformer = \( m, cmdm ) -> newUpdate cmdm m 240 | } 241 | 242 | 243 | {-| Transform an element program using [CmdM](#CmdM) into a normal element program. 244 | -} 245 | element : 246 | { init : flags -> ( model, CmdM msg ) 247 | , view : model -> Html (CmdM msg) 248 | , update : msg -> model -> ( model, CmdM msg ) 249 | , subscriptions : model -> Sub (CmdM msg) 250 | } 251 | -> Program flags model msg 252 | element args = 253 | let 254 | new = 255 | transform args.update 256 | in 257 | Browser.element 258 | { update = new.update 259 | , init = args.init >> new.initTransformer 260 | , view = args.view 261 | , subscriptions = args.subscriptions 262 | } 263 | 264 | 265 | {-| Transform a document program using [CmdM](#CmdM) into a normal document program. 266 | -} 267 | document : 268 | { init : flags -> ( model, CmdM msg ) 269 | , view : model -> Document (CmdM msg) 270 | , update : msg -> model -> ( model, CmdM msg ) 271 | , subscriptions : model -> Sub (CmdM msg) 272 | } 273 | -> Program flags model msg 274 | document args = 275 | let 276 | new = 277 | transform args.update 278 | in 279 | Browser.document 280 | { update = new.update 281 | , init = args.init >> new.initTransformer 282 | , view = args.view 283 | , subscriptions = args.subscriptions 284 | } 285 | 286 | 287 | {-| Transform an application program using [CmdM](#CmdM) into a normal application program. 288 | -} 289 | application : 290 | { init : flags -> Url -> Key -> ( model, CmdM msg ) 291 | , view : model -> Document (CmdM msg) 292 | , update : msg -> model -> ( model, CmdM msg ) 293 | , subscriptions : model -> Sub (CmdM msg) 294 | , onUrlRequest : UrlRequest -> CmdM msg 295 | , onUrlChange : Url -> CmdM msg 296 | } 297 | -> Program flags model msg 298 | application args = 299 | let 300 | new = 301 | transform args.update 302 | in 303 | Browser.application 304 | { update = new.update 305 | , init = \f u k -> new.initTransformer (args.init f u k) 306 | , view = args.view 307 | , subscriptions = args.subscriptions 308 | , onUrlRequest = args.onUrlRequest 309 | , onUrlChange = args.onUrlChange 310 | } 311 | -------------------------------------------------------------------------------- /src/CmdM/Internal.elm: -------------------------------------------------------------------------------- 1 | module CmdM.Internal exposing (Effect(..), CmdM(..), effectMap) 2 | 3 | 4 | type CmdM msg 5 | = Pure msg 6 | | Impure (Effect (CmdM msg)) 7 | 8 | -- Utils 9 | 10 | type Effect a = Batch (List a) 11 | | Command (Cmd a) 12 | 13 | effectMap : (a -> b) -> Effect a -> Effect b 14 | effectMap f base = 15 | case base of 16 | Batch l -> Batch (List.map f l) 17 | Command c -> Command (Cmd.map f c) -------------------------------------------------------------------------------- /src/IO.elm: -------------------------------------------------------------------------------- 1 | module IO exposing 2 | ( IO 3 | , Program, sandbox, element, document, application 4 | , pure, lift, liftM, liftUpdate 5 | , get, set, modify 6 | , map, andThen, join, ap, flap, compose, seq, traverse, mapM 7 | , lens, optional, iso, prism, replace 8 | , none, dummyUpdate, dummySub 9 | , yield, forceRendering 10 | , transform 11 | , batch, batchM 12 | ) 13 | 14 | {-| This module provides a monadic interface for _The Elm Architecture_. 15 | 16 | Basically [IO](#IO) is a monad enabing two kinds of effects : 17 | 18 | - **model modification**: 19 | it is a [state monad](http://brandon.si/code/the-state-monad-a-tutorial-for-the-confused/) 20 | whose state is the model. It can be read by [get](#get) and written by [set](#set). 21 | - _Cmd_ and [CmdM](../CmdM) **commands**. 22 | 23 | @docs IO 24 | 25 | 26 | # Runing a web application with [IO](#IO) 27 | 28 | This module port the two main ways of running an Elm application to [IO](#IO). 29 | 30 | @docs Program, sandbox, element, document, application 31 | 32 | 33 | # Lifting values and commands into [IO](#IO) 34 | 35 | @docs pure, lift, liftM, liftUpdate 36 | 37 | 38 | # The model as a state 39 | 40 | @docs get, set, modify 41 | 42 | 43 | # Classic monadic operations 44 | 45 | @docs map, andThen, join, ap, flap, compose, seq, traverse, mapM 46 | 47 | # Passing from a model to another via [optics](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest) 48 | 49 | @docs lens, optional, iso, prism, replace 50 | 51 | # Dummy values 52 | 53 | @docs none, dummyUpdate, dummySub 54 | 55 | # Forces Elm rendering 56 | 57 | @docs yield, forceRendering 58 | 59 | # Transform IO into regular Elm 60 | 61 | @docs transform 62 | 63 | 64 | # Batch operations 65 | 66 | Beware that batch operations might not do what you think. The execution order of 67 | messages and commands is **not defined**. 68 | 69 | @docs batch, batchM 70 | 71 | -} 72 | 73 | import Browser exposing (..) 74 | import Browser.Navigation exposing (Key) 75 | import CmdM exposing (..) 76 | import CmdM.Internal 77 | import Html exposing (..) 78 | import IO.Internal exposing (..) 79 | import Monocle.Iso exposing (..) 80 | import Monocle.Lens exposing (..) 81 | import Monocle.Optional exposing (..) 82 | import Monocle.Prism exposing (..) 83 | import Platform.Cmd exposing (..) 84 | import Url exposing (..) 85 | import Process 86 | import Task 87 | 88 | 89 | {-| Monadic interface for _The Elm Architecture_. 90 | 91 | A value of type `IO model a` is an effectful 92 | computation that can modify the model `model`, 93 | perform commands and contains values of type `a`. 94 | 95 | -} 96 | type alias IO model msg = 97 | IO.Internal.IO model msg 98 | 99 | -- Monadic 100 | 101 | 102 | {-| Returns an [IO](#IO) whose only effect is containing the value given to [pure](#pure). 103 | -} 104 | pure : a -> IO model a 105 | pure a = 106 | Pure a 107 | 108 | 109 | {-| Send messages in batch mode 110 | -} 111 | batch : List a -> IO model a 112 | batch l = Impure (Batch (List.map Pure l)) 113 | 114 | {-| Lift a _Cmd_ as an [IO](#IO). 115 | -} 116 | lift : Cmd a -> IO model a 117 | lift cmd = Impure (Command (Cmd.map Pure cmd)) 118 | 119 | {-| An [IO](#IO) that returns the current model. 120 | -} 121 | get : IO model model 122 | get = Impure (Get Pure) 123 | 124 | 125 | {-| An [IO](#IO) that sets the model. 126 | -} 127 | set : model -> IO model () 128 | set s = Impure (Set s Pure) 129 | 130 | 131 | {-| Map a function over an [IO](#IO). 132 | 133 | **Laws** 134 | 135 | - `map (f >> g) = (map f) >> (map g)` 136 | - `map identity = identity` 137 | 138 | -} 139 | map : (a -> b) -> IO model a -> IO model b 140 | map f = 141 | let aux ioa = 142 | case ioa of 143 | Pure a -> Pure (f a) 144 | Impure m -> Impure (effectMap aux m) 145 | in aux 146 | 147 | 148 | {-| Chains [IO](#IO)s. 149 | 150 | If you have an _IO model a_ and a function which given 151 | a _a_ can give you an _IO model b_ depending on the value 152 | of type _a_ given to the function. Then [andThen](#andThen) gives you 153 | an _IO model b_ that will run the first [IO](#IO) and then apply 154 | the function. 155 | 156 | **Laws** 157 | 158 | - `andThen pure = identity` 159 | - `andThen (f >> pure) = map f` 160 | - `(andThen f) >> (andThen g) = andThen (a -> andThen g (f a))` 161 | 162 | -} 163 | andThen : (a -> IO model b) -> IO model a -> IO model b 164 | andThen f = 165 | let aux m = 166 | case m of 167 | Pure a -> f a 168 | Impure x -> Impure (effectMap aux x) 169 | in aux 170 | 171 | 172 | {-| Flatten an [IO](#IO) containing an [IO](#IO) into a simple [IO](#IO). 173 | 174 | **Laws** 175 | 176 | - `join (pure m) = m` 177 | 178 | -} 179 | join : IO model (IO model a) -> IO model a 180 | join = andThen identity 181 | 182 | 183 | {-| Transform an [IO](#IO) containing functions into functions on [IO](#IO) 184 | It enable to easily lift functions to [IO](#IO). 185 | 186 | **Laws** 187 | 188 | - `ap (pure identity) = identity` 189 | - `ap (pure (f >> g)) = ap (pure f) >> ap (pure g)` 190 | 191 | -} 192 | ap : IO model (a -> b) -> IO model a -> IO model b 193 | ap mf ma = andThen (\y -> map y ma) mf 194 | 195 | {-| Flipped version of ap. To be used like: 196 | 197 | pure f |> flap arg1 |> flap arg2 ... 198 | -} 199 | flap : IO model a -> IO model (a -> b) -> IO model b 200 | flap ma mf = ap mf ma 201 | 202 | {-| Composition of monadic functions 203 | -} 204 | compose : (b -> IO m c) -> (a -> IO m b) -> a -> IO m c 205 | compose g f a = f a |> andThen g 206 | 207 | {-| Run the second argument, ignore the result, then run the first one. 208 | To be used in 209 | 210 | first |> seq second 211 | -} 212 | seq : IO model b -> IO model a -> IO model b 213 | seq second first = first |> andThen (\_ -> second) 214 | 215 | -- Monoid 216 | 217 | {-| An [IO](#IO) doing nothing (an containing no values!). 218 | -} 219 | none : IO model a 220 | none = batch [] 221 | 222 | 223 | {-| **Its use is strongly discouraged! Use [mapM](#mapM) instead!** 224 | Combine a list of [IO](#IO). 225 | -} 226 | batchM : List (IO model a) -> IO model a 227 | batchM l = join (batch l) 228 | 229 | -- Tansformer 230 | 231 | {-| Lift a [CmdM](../CmdM) into an [IO](#IO) 232 | -} 233 | liftM : CmdM a -> IO model a 234 | liftM cmdm = 235 | case cmdm of 236 | CmdM.Internal.Pure a -> Pure a 237 | CmdM.Internal.Impure imp -> Impure ( 238 | case imp of 239 | CmdM.Internal.Batch l -> Batch (List.map liftM l) 240 | CmdM.Internal.Command c -> Command (Cmd.map liftM c) 241 | ) 242 | 243 | 244 | {-| Lift a classic update function into an [IO](#IO). 245 | -} 246 | liftUpdate : (model -> ( model, Cmd a )) -> IO model a 247 | liftUpdate f = Impure (Get (\m0 -> Impure ( 248 | let (m2, cmd) = f m0 249 | in Set m2 (\() -> Impure (Command (Cmd.map Pure cmd))) 250 | ))) 251 | -- State 252 | 253 | {-| A [IO](#IO) that modify the model. 254 | -} 255 | modify : (model -> model) -> IO model () 256 | modify f = Impure (Get (\m -> Impure (Set (f m) Pure))) 257 | 258 | -- Optics 259 | 260 | {-| Congruence by a [Lens](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest/Monocle-Lens) on an [IO](#IO). 261 | 262 | It would be silly to force users to redefine every [IO](#IO) 263 | for each application model. Lenses enable to lift an [IO](#IO) 264 | action on a model _a_ to the same [IO](#IO) but action on a 265 | model _b_. 266 | 267 | You can then define your [IO](#IO) on the minimal model and 268 | lift them to you real application's model when needed. 269 | 270 | -} 271 | lens : Lens b a -> IO a msg -> IO b msg 272 | lens ll = 273 | let aux ioa = 274 | case ioa of 275 | Pure msg -> Pure msg 276 | Impure x -> Impure ( 277 | case x of 278 | Get f -> Get (ll.get >> f >> aux) 279 | Set a f -> Get (\b -> Impure (Set (ll.set a b) (f >> aux))) 280 | Batch l -> Batch (List.map aux l) 281 | Command c -> Command (Cmd.map aux c) 282 | ) 283 | in aux 284 | 285 | {-| Congruence by a [Optional](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest/Monocle-Optional) on an [IO](#IO). 286 | Just like lenses but with [Optional](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest/Monocle-Optional). 287 | If the optional returns `Nothing`, then the [IO](#IO) does nothing. 288 | -} 289 | optional : Optional b a -> IO a msg -> IO b msg 290 | optional opt = 291 | let aux ioa = 292 | case ioa of 293 | Pure msg -> Pure msg 294 | Impure x -> Impure ( 295 | case x of 296 | Get f -> Get (\b -> case opt.getOption b of 297 | Nothing -> none 298 | Just a -> aux (f a) 299 | ) 300 | Set a f -> Get (\b -> Impure (Set (opt.set a b) (f >> aux))) 301 | Batch l -> Batch (List.map aux l) 302 | Command c -> Command (Cmd.map aux c) 303 | ) 304 | in aux 305 | 306 | 307 | {-| Congruence by a [Iso](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest/Monocle-Iso) on an [IO](#IO). 308 | Just like lenses but with [Iso](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest/Monocle-Iso). 309 | -} 310 | iso : Iso b a -> IO a msg -> IO b msg 311 | iso liso = 312 | let aux iob = 313 | case iob of 314 | Pure msg -> Pure msg 315 | Impure x -> Impure ( 316 | case x of 317 | Get f -> Get (liso.get >> f >> aux) 318 | Set a f -> Set (liso.reverseGet a) (f >> aux) 319 | Batch l -> Batch (List.map aux l) 320 | Command c -> Command (Cmd.map aux c) 321 | ) 322 | in aux 323 | 324 | 325 | {-| Congruence by a [Prism](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest/Monocle-Prism) on an [IO](#IO). 326 | Just like lenses but with [Prism](http://package.elm-lang.org/packages/arturopala/elm-monocle/latest/Monocle-Iso). 327 | If the prism returns `Nothing`, then the [IO](#IO) does nothing. 328 | -} 329 | prism : Prism b a -> IO a msg -> IO b msg 330 | prism prsm = 331 | let aux ioa = 332 | case ioa of 333 | Pure msg -> Pure msg 334 | Impure x -> Impure ( 335 | case x of 336 | Get f -> Get (\b -> case prsm.getOption b of 337 | Nothing -> none 338 | Just a -> aux (f a) 339 | ) 340 | Set a f -> Set (prsm.reverseGet a) (f >> aux) 341 | Batch l -> Batch (List.map aux l) 342 | Command c -> Command (Cmd.map aux c) 343 | ) 344 | in aux 345 | 346 | 347 | {-| Replace get and set by custom functions -} 348 | replace : IO b a -> (a -> IO b ()) -> IO a x -> IO b x 349 | replace rget rset = 350 | let aux : IO a x -> IO b x 351 | aux ioa = 352 | case ioa of 353 | Pure x -> Pure x 354 | Impure (Get k) -> rget |> andThen (k >> aux) 355 | Impure (Set a k) -> rset a |> andThen (k >> aux) 356 | Impure (Batch l) -> Impure (Batch (List.map aux l)) 357 | Impure (Command c) -> Impure (Command (Cmd.map aux c)) 358 | in aux 359 | 360 | {-| You can think of traverse like a [map](#map) but with effects. 361 | It maps a function performing [IO](#IO) effects over a list. 362 | -} 363 | traverse : (a -> IO model b) -> List a -> IO model (List b) 364 | traverse f = 365 | let aux l = 366 | case l of 367 | [] -> pure [] 368 | hd :: tl -> ap (ap (pure (::)) (f hd)) (aux tl) 369 | in aux 370 | 371 | {-| Transform a list of [IO](#IO) into an [IO](#IO) of list. 372 | -} 373 | mapM : List (IO model a) -> IO model (List a) 374 | mapM = traverse identity 375 | 376 | -- Dummy 377 | 378 | {-| Dummy update function. 379 | -} 380 | dummyUpdate : a -> IO b c 381 | dummyUpdate _ = none 382 | 383 | 384 | {-| Dummy subscription function 385 | -} 386 | dummySub : a -> Sub b 387 | dummySub a = Sub.none 388 | 389 | {-| Identity function that forces Elm to render 390 | the current state. Is equivalent to sleep for 391 | 0 milliseconds. 392 | -} 393 | yield : msg -> IO model msg 394 | yield msg = lift (Task.perform (\_ -> msg) (Process.sleep 0)) 395 | 396 | {-| Forces Elm to render every set operation (model update). 397 | This is MUCH SLOWER than normal set operations. 398 | -} 399 | forceRendering : IO a b -> IO a b 400 | forceRendering = replace get (set |> compose yield) 401 | 402 | -- Platform 403 | 404 | {-| Program using [IO](#IO). 405 | -} 406 | type alias Program flags model msg = 407 | Platform.Program flags model (IO model msg) 408 | 409 | -- The core of all the [IO](#IO) monad! It runs the [IO](#IO) monad using the update function. 410 | 411 | runUpdate : (msg -> IO model msg) -> IO model msg -> model -> ( model, Cmd (IO model msg) ) 412 | runUpdate f = 413 | let recur : IO model msg -> model -> (model, Cmd (IO model msg)) 414 | recur io1 model = 415 | case io1 of 416 | Pure msg -> recur (f msg) model 417 | Impure x -> 418 | case x of 419 | Get k -> recur (k model) model 420 | Set m k -> recur (k ()) m 421 | Batch l -> let (m4, ios4) = List.foldl (\io (ma, ios) -> 422 | let (m3, cmd) = recur io ma 423 | in (m3, cmd :: ios) 424 | ) (model, []) l 425 | in (m4, Cmd.batch ios4) 426 | Command cmd -> (model, cmd) 427 | in recur 428 | 429 | 430 | {-| Transform a program using [IO](#IO) into a normal program. 431 | -} 432 | transform : 433 | (msg -> IO model msg) 434 | -> 435 | { update : IO model msg -> model -> ( model, Cmd (IO model msg) ) 436 | , initTransformer : ( model, IO model msg ) -> ( model, Cmd (IO model msg) ) 437 | } 438 | transform update = 439 | let newUpdate = runUpdate update 440 | in { update = newUpdate 441 | , initTransformer = \( m, io ) -> newUpdate io m 442 | } 443 | 444 | {-| Transform an element program using [IO](#IO) into a normal element program. 445 | -} 446 | element : 447 | { init : flags -> ( model, IO model msg ) 448 | , view : model -> Html (IO model msg) 449 | , update : msg -> IO model msg 450 | , subscriptions : model -> Sub (IO model msg) 451 | } 452 | -> Program flags model msg 453 | element args = 454 | let new = transform args.update 455 | in Browser.element 456 | { update = new.update 457 | , init = args.init >> new.initTransformer 458 | , view = args.view 459 | , subscriptions = args.subscriptions 460 | } 461 | 462 | {-| Transform a sandbox program using [IO](#IO) into a normal sandbox program. 463 | -} 464 | sandbox : 465 | { init : flags -> ( model, IO model msg ) 466 | , view : model -> Html (IO model msg) 467 | , subscriptions : model -> Sub (IO model msg) 468 | } 469 | -> Program flags model msg 470 | sandbox args = element { init = args.init, 471 | view = args.view, 472 | update = dummyUpdate, 473 | subscriptions = args.subscriptions 474 | } 475 | 476 | {-| Transform a document program using [IO](#IO) into a normal document program. 477 | -} 478 | document : 479 | { init : flags -> ( model, IO model msg ) 480 | , view : model -> Document (IO model msg) 481 | , update : msg -> IO model msg 482 | , subscriptions : model -> Sub (IO model msg) 483 | } 484 | -> Program flags model msg 485 | document args = 486 | let new = transform args.update 487 | in Browser.document 488 | { update = new.update 489 | , init = args.init >> new.initTransformer 490 | , view = args.view 491 | , subscriptions = args.subscriptions 492 | } 493 | 494 | 495 | {-| Transform an application program using [IO](#IO) into a normal application program. 496 | -} 497 | application : 498 | { init : flags -> Url -> Key -> ( model, IO model msg ) 499 | , view : model -> Document (IO model msg) 500 | , update : msg -> IO model msg 501 | , subscriptions : model -> Sub (IO model msg) 502 | , onUrlRequest : UrlRequest -> IO model msg 503 | , onUrlChange : Url -> IO model msg 504 | } 505 | -> Program flags model msg 506 | application args = 507 | let new = transform args.update 508 | in Browser.application 509 | { update = new.update 510 | , init = \f u k -> new.initTransformer (args.init f u k) 511 | , view = args.view 512 | , subscriptions = args.subscriptions 513 | , onUrlRequest = args.onUrlRequest 514 | , onUrlChange = args.onUrlChange 515 | } -------------------------------------------------------------------------------- /src/IO/Internal.elm: -------------------------------------------------------------------------------- 1 | module IO.Internal exposing (Effect(..), IO(..), effectMap) 2 | 3 | import CmdM.Internal as CmdM 4 | 5 | type IO model a 6 | = Pure a 7 | | Impure (Effect model (IO model a)) 8 | 9 | -- Utils 10 | {- This type is useful to *get* the model without having to pass 11 | through a *Cmd*. Accessing the model is an effect, it has to go 12 | in the *Impure* case. But This is not a *Cmd* effect, it is not 13 | an effect for the elm runtime. So putting a value `a` into a *Cmd* 14 | makes no sense! *CmdP* (for *Cmd* + *Pure*) enable to store a pure 15 | value as an effect without passing in the elm runtime. 16 | -} 17 | 18 | 19 | type Effect model a = Get (model -> a) 20 | | Set model (() -> a) 21 | | Batch (List a) 22 | | Command (Cmd a) 23 | 24 | effectMap : (a -> b) -> Effect model a -> Effect model b 25 | effectMap f b = 26 | case b of 27 | Get k -> Get (k >> f) 28 | Set m k -> Set m (k >> f) 29 | Batch l -> Batch (List.map f l) 30 | Command c -> Command (Cmd.map f c) --------------------------------------------------------------------------------