elm examples

encoding pairs (String,String)

import Html exposing (text,div,br)
import Json.Encode
import Markdown

type alias R = List(String,String)

t = ("a","b")

r = [t,t]

s = "foo"

enc = encPair t

encPair : (String,String) -> Json.Encode.Value
encPair r = 
  let
    (a,b) = r
  in
    Json.Encode.object [(a, Json.Encode.string b)]
    
encLst : R -> Json.Encode.Value
encLst lst = 
  List.map (\x -> encPair x) lst |> Json.Encode.list
  
jMark : String -> String
jMark s = 
  "\n\n```" ++ s ++ "```"

main =
  div [] [
    text <| "Json Encoding" 
    , Markdown.toHtml [] (jMark (Json.Encode.encode 2 enc))
    , br [] []
    , Markdown.toHtml [] (jMark (Json.Encode.encode 2 (encLst r)))
    ]

contenteditable

import Html exposing (text, p)
import Html.Attributes exposing (..)

main =
  p [ contenteditable True ][ text "Hello, World! click to edit" ]

mock child component using http example

import Html exposing (..)
import Html.App as App
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Http
import Json.Decode as Json
import Task



main =
  App.program
    { init = init "cats"
    , view = view
    , update = update
    , subscriptions = subscriptions
    }




-- Parent Stuff
-- MODEL


type alias Model =
  { topic : String
  , gifUrl : String
  , child : ChildModel
  }




init : String -> (Model, Cmd Msg)
init topic =
  let 
    childMsg = childGet
  in
  ( Model topic "waiting.gif" child_init
  , Cmd.batch [getRandomGif topic, Cmd.map ChildProxy childGet]
  )



-- UPDATE


type Msg
  = MorePlease
  | FetchSucceed String
  | FetchFail Http.Error
  | ChildGet
  | ChildProxy ChildMsg


update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case msg of
    MorePlease ->
      (model, getRandomGif model.topic)

    FetchSucceed newUrl ->
      ({model | gifUrl = newUrl}, Cmd.none)

    FetchFail _ ->
      (model, Cmd.none)
    ChildGet -> 
      let
        cmd = childGet
        mapped_cmd = Cmd.map (\x -> ChildProxy x) cmd
      in
        (model, mapped_cmd)
    ChildProxy proxy_msg -> 
      let 
       (child_model, child_msg) = child_update proxy_msg model.child
      in
       ({model | child = child_model}, Cmd.none)
     


    
-- VIEW



view : Model -> Html Msg
view model =
 let
  child_stuff = App.map (\x -> ChildProxy x) (child_view model.child)
  --child_stuff = App.map (\x -> x) (child_view model.child)
 in
  div []
    [ h2 [] [text model.topic]
    , button [ onClick MorePlease ] [ text "More Cats!" ]
    , button [ onClick ChildGet ] [ text "More Coffee!" ]
    , br [] []
    , img [src model.gifUrl] []
    , child_stuff
    ]



-- SUBSCRIPTIONS


subscriptions : Model -> Sub Msg
subscriptions model =
  Sub.none



-- HTTP


getRandomGif : String -> Cmd Msg
getRandomGif topic =
  let
    url =
      "https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic
  in
    Task.perform FetchFail FetchSucceed (Http.get decodeGifUrl url)
    


-- Child Stuff

--Model

type alias ChildModel = {txt : String, gifUrl : String}

child_init : ChildModel
child_init = {txt = "init", gifUrl = "waiting.gif"}

--Update

type ChildMsg = 
  Go
  | Win String
  | Fail Http.Error

child_update : ChildMsg -> ChildModel -> (ChildModel,Cmd Msg)
child_update msg model = 
  case msg of 
    Go ->
      let 
        --cmd = Task...
        x = 1
      in
        --(model, cmd)
        (model, Cmd.none)
    Win newUrl ->
      ({model | txt = "won", gifUrl = newUrl}, Cmd.none)
    Fail _ -> 
      ({model | txt = "did not win"}, Cmd.none)

--View

child_view : ChildModel -> Html ChildMsg
child_view model = 
  div [] [
    text <| "Child: " ++ model.txt
    , hr [] []
    , text <| "Url: " ++ model.gifUrl
    , br [] []
    , img [src model.gifUrl] []
  ]
--HTTP
childGet : Cmd ChildMsg
childGet = 
  Task.perform Fail Win (Http.get decodeGifUrl "https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=coffee")
-- Shared Stuff


decodeGifUrl : Json.Decoder String
decodeGifUrl =
  Json.at ["data", "image_url"] Json.string

json decoding

import Html exposing (text,div,hr)
import Json.Decode

--|  this is our test json string.  it uses """ syntax for multi line strings
jsonString = 
   """ 

   [
   { "key" : "bar" } 
   ]

   """

--| This is for our json object type alias

type alias LstItem = {key: String}


--| This alias defines a simple list of json objects [{"key":"value"}]

type alias Lst = List LstItem


--| this defines a decoder for the Json objects in our list.

decoder = Json.Decode.object1 LstItem (Json.Decode.at ["key"] Json.Decode.string)


--| This defines a decoder function to process a list

decodeLst : Json.Decode.Decoder Lst
decodeLst = Json.Decode.list decoder


--|  this function actually runs the decoder and produces a Result
doDecodeLst : Json.Decode.Decoder a -> String -> Result String a
doDecodeLst decodeLst raw_string = 
  Json.Decode.decodeString decodeLst raw_string


--|  this one runs the decoder and processes the Result into an empty list or 
--|  the decoded list and disregards any errors

maybeDecodeLst : Json.Decode.Decoder (List LstItem) -> String -> List LstItem
maybeDecodeLst decodeLst raw_string = 
  case Json.Decode.decodeString decodeLst raw_string of
    Err str -> []
    Ok lst -> lst


--| the main program, in this case a view.

main =
  div [] [
    text "decoding json"
    , text "the first version creates a result: "
    , text <| toString (doDecodeLst decodeLst jsonString)
    , hr [] []
    , text "the second version creates a record: "
    , text <| toString (maybeDecodeLst decodeLst jsonString)
    , hr [] []
    , text "the third version creates an error by using the wrong decoder: "
    , text <| toString (doDecodeLst decoder jsonString)
    ]

frustrated with the difficulty to update nested data I was testing a few ways to provide something simular to elixir's put_in function

- recursion and unnesting

import Html exposing (text,div,hr)
import Dict
import String

main =
  let 
    unnested = unnest p Dict.empty ""
    path = [":parent","child1"]
    pathString = String.join ":" path
    found = Dict.get pathString unnested 
      
    updated = if found == Nothing then
      False
    else       
      True
  in
   div [] [
    text "Recurse! ->"
    , text (toString p)
    , hr [] []
    , text "Unnest! ->"
    , text (toString unnested)
    , hr [] []
    , text <| " path string: " ++ pathString ++ " ... "
    , text (toString found)
    , hr [] []
    , text <| " updated: " ++ (toString updated)
    ]
    
--unnest : Response -> String
unnest : Response -> Dict.Dict String Response -> String -> Dict.Dict String Response
unnest comment dict path = 
  case comment of
    NoChild rec -> dict
    ParentResponse rec -> 
      let 
        newPath = path ++ ":" ++  rec.name
        newDict = Dict.insert newPath comment dict
        com = rec.response
      in
        unnest com newDict newPath
        
nest : Dict.Dict String Response -> Response 
nest dict = 
  p

type Response 
  = ParentResponse {
    name : String
    , b : Bool
    , s : String
    , response : Response
    }
  
  | NoChild {
    name : String
    , b : Bool
    , s : String
    , response : Bool
    }

p : Response
p = 
  ParentResponse {
  name = "parent"
  , b = False
  , s = ""
  , response = c1
  }
  

c1 : Response
c1 = 
  ParentResponse {
  name = "child1"
  , b = False
  , s = ""
  , response = c2
  }

c2 : Response
c2 = 
  ParentResponse {
  name = "child2"
  , b = False
  , s = ""
  , response = c3
  }
  
c3 : Response
c3 = 
  ParentResponse {
  name = "child3"
  , b = False
  , s = ""
  , response = c4
  }
  
c4 : Response
c4 = 
  NoChild {
  name = "child"
  , b = False
  , s = ""
  , response = True
  }

and…

import Html exposing (text,div,hr)
import Dict

main =
  div [] [
    text ("Hello, World!" ++ (toString record) ++ (toString dict))
    , hr [] []
    --, text (toString (recIt record))
    , text (toString (recIt record))
    , hr [] []
    , text "Tuples: "
    , text (toString tpls)
    , hr [] []
    , text "put_in: "
    --, text (toString (put_in tpls))
    , text (toString (put_in list3d ["name", "name2"]))
    , text "todo: you were going to try to pattern match out a match on your update of the nested path"
    
  ]
  
record = 
  {
  foo = ("String","foo")
  ,bar = {t = "Int",v = "1"}
  }
  
record2 = 
  {
  nofoo = {t = "Bool", v = "True"}
  }
  
-- name, type, value
tpls = 
  [
    ( "foo", "Bool", "True")
    --, ( "bar", "List", 
    --    ("baz", "Bool", "False")
    --  )
  ]
  
niltpl = ("foo", "String", ("","","string var"))
nesttpl = ("bar", "Nest", ("baz", "String", " nested var"))

moretpls = 
  [
    niltpl
    , nesttpl
    ]

type alias Item = (String, String, String) 
type alias ItemList = (String, String, Item)
type alias SuperItem = (String, String, MaybeString)

--type Thing = Item | ItemList

type MaybeString = String | Item


type alias ThreeDeep = 
  ( String, String, 
      ( String, String,
          ( String, String, String)
      )
   )
threedeep = 
   ("name", "type",
     ("name2", "type",
       ("", "value depth2", "")
     )
   )
threedeep2 = 
   ("name", "type",
     ("name2", "type",
       ("name3", "type", "value depth 3")
     )
   )
threedeep3 = 
   ("name", "type",
     ("", "value depth 1",
       ("", "", "")
     )
   )
   
list3d = [ threedeep, threedeep2, threedeep3 ]

put_in : List ThreeDeep -> List String -> List String
put_in lst path = 
  --["foo"]
  let
    -- map list to find first path map
    x = 1
  in
    -- return something
    ["foo"]
  
--put_in : List SuperItem -> List String -> List String
--put_in tpl names = 
  --["foo"]
  
--recFun : 

dict = Dict.fromList 
  [
  ("key", { name = "foo"})
  , ("key2", { name = "1"})
  , ("key", { name = "same key"})
  ]
  
type Splay = A | B
splay : Splay -> String
splay input =
  case input of
    A -> "out"
    B -> "out2"
    

recIt record = 
  case record of
    {foo} -> {hasFoo = True}
    --{foo, bar} -> {hasFoo = False}

%{description: "a few examples from learning elm", title: "elm examples"}

(Optional) See our JavaScript configuration variables documentation for ways to further customize the Disqus embed code.