m

.gitignore

@@ -3,6 +3,7 @@
 devenv.local.nix
 db
 datasets
+elm-stuff
 
 # direnv
 .direnv

devenv.nix

@@ -4,7 +4,19 @@
   config,
   inputs,
   ...
-}: {
+}: let
+  nsrc = pkgs.fetchFromGitHub {
+    owner = "elm-tooling";
+    repo = "elm-language-server";
+    rev = "0dc4076180fe7e758bed267a84911cc202011a13";
+    sha256 = "1xys9a468fy1vxlby8pmvnpv0kg5hr4956mdp2kclvs55k4j9y43";
+  };
+  elm-lsp =
+    lib.overrideDerivation pkgs.elmPackages.elm-language-server
+    (drv: {
+      src = nsrc;
+    });
+in {
   # https://devenv.sh/basics/
   env.GREET = "devenv";
 
@@ -13,12 +25,20 @@
     sqlite
     nodePackages.typescript-language-server
     nodePackages.prettier
+    elm2nix
+    elmPackages.elm
+    elmPackages.elm-format
+    elmPackages.elm-review
+    elmPackages.elm-test-rs
+    elmPackages.elm-land
+    elm-lsp
+    # elmPackages.lamdera  # lol
   ];
 
   # https://devenv.sh/languages/
   # languages.rust.enable = true;
   languages = {
-    elm.enable = true;
+    # elm.enable = true;
     javascript = {
       enable = true;
       bun.enable = true;

ui/elm.json

@@ -11,13 +11,14 @@
             "elm/html": "1.0.0",
             "elm/http": "2.0.0",
             "elm/json": "1.1.3",
+            "elm/url": "1.0.0",
+            "elm-community/list-extra": "8.7.0",
             "mdgriffith/elm-ui": "1.1.8"
         },
         "indirect": {
             "elm/bytes": "1.0.8",
             "elm/file": "1.0.5",
             "elm/time": "1.0.0",
-            "elm/url": "1.0.0",
             "elm/virtual-dom": "1.0.3"
         }
     },

ui/src/Api.elm

@@ -1,46 +1,22 @@
-module Api exposing (Card, Lesson, Lessons, ServerResponse(..), fetchLessons)
+module Api exposing (addUser, fetchLesson, fetchLessons)
 
 import Dict exposing (Dict)
 import Http
 import Json.Decode as Decode
+import Json.Encode as Encode
+import Types exposing (Card, Lesson, Lessons, Msg(..), ServerResponse(..))
 
 
 
 -- data types
-
-
-type alias Card =
-    { text : String
-    , note : Maybe String
-    , id : Int
-    }
-
-
-type alias Lesson =
-    { text : String
-    , id : Int
-    , cards : List Card
-    }
-
-
-type alias Lessons =
-    Dict Int Lesson
-
-
-type ServerResponse
-    = OkResponse Lessons
-    | ErrorResponse String
-
-
-
 -- json decoders
 
 
-serverResponseDecoder : Decode.Decoder ServerResponse
+serverResponseDecoder : Decode.Decoder t -> Decode.Decoder (ServerResponse t)
-serverResponseDecoder =
+serverResponseDecoder okDecoder =
     Decode.oneOf
         [ Decode.map OkResponse
-            (Decode.field "ok" lessonsDecoder)
+            (Decode.field "ok" okDecoder)
         , Decode.map ErrorResponse (Decode.field "error" Decode.string)
         ]
 
@@ -86,14 +62,43 @@ convertKeysToIntDict stringKeyedDict =
 
 
 
+-- json encoders
+
+
+newUserEncoder name creds =
+    Encode.object [ ( "name", Encode.string name ), ( "creds", Encode.string creds ) ]
+
+
+
 -- http command
 
 
-fetchLessons : (Result Http.Error ServerResponse -> msg) -> Cmd msg
+fetchLessons : Cmd Msg
-fetchLessons toMsg =
+fetchLessons =
     Http.get
         { url = "http://localhost:3000/api/lessons"
-        , expect = Http.expectJson toMsg serverResponseDecoder
+        , expect = Http.expectJson FetchLessons (serverResponseDecoder lessonsDecoder)
+        }
+
+
+fetchLesson : Int -> Cmd Msg
+fetchLesson num =
+    Http.get
+        { url = "http://localhost:3000/api/lesson/" ++ String.fromInt num
+        , expect = Http.expectJson FetchLesson (serverResponseDecoder lessonDecoder)
+        }
+
+
+
+-- post requests
+
+
+addUser : String -> String -> Cmd Msg
+addUser name pw =
+    Http.post
+        { url = "http://localhost:3000/api/lessons"
+        , body = Http.jsonBody (newUserEncoder name pw)
+        , expect = Http.expectJson FetchLessons (serverResponseDecoder lessonsDecoder)
         }
 
 

ui/src/Homepage.elm

@@ -0,0 +1,109 @@
+module Homepage exposing (page)
+
+import Dict
+import Element exposing (..)
+import Html exposing (Html)
+import Types exposing (Lesson, Lessons, Model, Msg(..))
+
+
+
+-- local state
+-- type Tab
+--     = Lessons
+--     | Words
+--     | Pronunciation
+-- tabEl : Tab -> Tab -> Element Msg
+-- tabEl tab selectedTab =
+--     let
+--         isSelected =
+--             tab == selectedTab
+--         padOffset =
+--             if isSelected then
+--                 0
+--             else
+--                 2
+--         borderWidths =
+--             if isSelected then
+--                 { left = 2, top = 2, right = 2, bottom = 0 }
+--             else
+--                 { bottom = 2, top = 0, left = 0, right = 0 }
+--         corners =
+--             if isSelected then
+--                 { topLeft = 6, topRight = 6, bottomLeft = 0, bottomRight = 0 }
+--             else
+--                 { topLeft = 0, topRight = 0, bottomLeft = 0, bottomRight = 0 }
+--     in
+--     el
+--         [ Border.widthEach borderWidths
+--         , Border.roundEach corners
+--         , Border.color color.blue
+--         , onClick <| UserSelectedTab tab
+--         ]
+--     <|
+--         el
+--             [ centerX
+--             , centerY
+--             , paddingEach { left = 30, right = 30, top = 10 + padOffset, bottom = 10 - padOffset }
+--             ]
+--         <|
+--             text <|
+--                 case tab of
+--                     Lessons ->
+--                         "Lessons"
+--                     Words ->
+--                         "Words"
+--                     Pronunciation ->
+--                         "Audio"
+
+
+page : Model -> Html Msg
+page model =
+    if model.isLoading then
+        layout [] (text "...")
+
+    else
+        layout [ width fill, height fill ] <|
+            el
+                [ centerX ]
+                (lessonsView model.lessons)
+
+
+lessonsView : Lessons -> Element Msg
+lessonsView lessons =
+    Dict.values lessons
+        |> List.map lessonPreview
+        |> column []
+
+
+lessonPreview : Lesson -> Element Msg
+lessonPreview lesson =
+    link []
+        { url = "/lesson/" ++ String.fromInt lesson.id
+        , label =
+            el [] <|
+                column []
+                    [ text ("Lesson: " ++ String.fromInt lesson.id)
+                    , text lesson.text
+                    ]
+        }
+
+
+
+-- mainpage : Model -> Html Msg
+-- mainpage model =
+--     if model.isLoading then
+--         layout [] (text "...")
+--     else
+--         layout [ width fill, height fill ] <|
+--             column
+--                 [ centerX ]
+--                 [ row []
+--                     [ tabEl Lessons model.tab
+--                     , tabEl Words model.tab
+--                     , tabEl Pronunciation model.tab
+--                     ]
+--                 , if model.tab == Lessons then
+--                     lessonsView model.lessons
+--                   else
+--                     el [] (text "WIP")
+--                 ]

ui/src/Lessonpage.elm

@@ -0,0 +1,85 @@
+module Lessonpage exposing (page)
+
+import Element exposing (..)
+import Element.Border as Border
+import Html exposing (Html)
+import List.Extra
+import Types exposing (Card, Lesson, Msg(..))
+
+
+
+-- local state
+-- type Tab
+--     = Lessons
+--     | Words
+--     | Pronunciation
+
+
+page : Lesson -> Int -> Html Msg
+page lesson cid =
+    let
+        _ =
+            Debug.log "lesson" lesson
+    in
+    layout [ width fill, height fill, inFront navbar ] <|
+        el
+            [ centerX ]
+            (lessonView lesson cid)
+
+
+lessonView : Lesson -> Int -> Element Msg
+lessonView lesson cid =
+    case List.Extra.getAt cid lesson.cards of
+        Just c ->
+            cardView c
+
+        Nothing ->
+            notFound
+
+
+cardView : Card -> Element Msg
+cardView card =
+    column []
+        [ el [] (text card.text)
+        , cardNote card.note
+        ]
+
+
+cardNote : Maybe String -> Element Msg
+cardNote ms =
+    case ms of
+        Just txt ->
+            el [] (text txt)
+
+        Nothing ->
+            el [] (text "")
+
+
+navbar : Element Msg
+navbar =
+    row
+        [ width fill
+        , padding 20
+        , spacing 20
+        , Border.widthEach { bottom = 2, left = 0, right = 0, top = 0 }
+        ]
+        [ el
+            [ width <|
+                px 80
+            , height <|
+                px 40
+            ]
+            (text "hi")
+        , el [ alignRight ] <| text "Settings"
+        ]
+
+
+
+-- TODO get rid of this, really bad form
+
+
+notFound : Element Msg
+notFound =
+    el
+        [ centerX ]
+        (text "404")

ui/src/Main.elm

@@ -1,49 +1,38 @@
 module Main exposing (..)
 
-import Api exposing (Card, Lesson, Lessons, ServerResponse(..), fetchLessons)
+import Api exposing (fetchLessons)
 import Browser
+import Browser.Navigation as Nav
 import Dict exposing (Dict)
 import Element exposing (..)
 import Element.Background as Background
 import Element.Border as Border
 import Element.Events exposing (onClick)
 import Element.Font as Font
-import Html exposing (Html)
+import Router exposing (parseUrl, router)
-import Http
+import Types exposing (Lessons, Model, Msg(..), Route(..), ServerResponse(..))
-
+import Url
-
-type Tab
-    = Lessons
-    | Words
-    | Pronunciation
-
-
-type Msg
-    = UserSelectedTab Tab
-    | FetchDataHandler (Result Http.Error ServerResponse)
 
 
 
 -- state
 
 
-type alias Model =
-    { lessons : Lessons
-    , tab : Tab
-    , isLoading : Bool
-    }
-
-
 sampleLessons : Lessons
 sampleLessons =
     Dict.fromList []
 
 
-initialState : Model
+initialState : Url.Url -> Nav.Key -> Model
-initialState =
+initialState url key =
+    let
+        route =
+            parseUrl url
+    in
     { isLoading = False
     , lessons = sampleLessons
-    , tab = Lessons
+    , route = route
+    , key = key
     }
 
 
@@ -54,10 +43,7 @@ initialState =
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        UserSelectedTab t ->
+        FetchLessons (Ok serres) ->
-            ( { model | tab = t }, Cmd.none )
-
-        FetchDataHandler (Ok serres) ->
             -- let
             --     _ =
             --         Debug.log "hi" serres
@@ -69,115 +55,73 @@ update msg model =
                 ErrorResponse _ ->
                     ( { model | isLoading = False }, Cmd.none )
 
-        FetchDataHandler (Err _) ->
+        FetchLessons (Err _) ->
             ( { model | isLoading = False }, Cmd.none )
 
+        FetchLesson res ->
+            ( { model | isLoading = False }, Cmd.none )
 
-view : Model -> Html Msg
+        LinkClicked urlRequest ->
+            let
+                _ =
+                    Debug.log "url request" urlRequest
+            in
+            case urlRequest of
+                Browser.Internal url ->
+                    ( model, Nav.pushUrl model.key (Url.toString url) )
+
+                Browser.External href ->
+                    ( model, Nav.load href )
+
+        UrlChanged url ->
+            let
+                newRoute =
+                    parseUrl url
+            in
+            ( { model | route = newRoute }, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions _ =
+    Sub.none
+
+
+view : Model -> Browser.Document Msg
 view model =
-    if model.isLoading then
-        layout [] (text "...")
-
-    else
-        layout [ width fill, height fill ] <|
-            column
-                [ centerX ]
-                [ row []
-                    [ tabEl Lessons model.tab
-                    , tabEl Words model.tab
-                    , tabEl Pronunciation model.tab
-                    ]
-                , if model.tab == Lessons then
-                    lessonsView model.lessons
-
-                  else
-                    el [] (text "WIP")
-                ]
-
-
-tabEl : Tab -> Tab -> Element Msg
-tabEl tab selectedTab =
     let
-        isSelected =
+        ( _, _, html ) =
-            tab == selectedTab
+            router model
 
-        padOffset =
+        --     _ =
-            if isSelected then
+        --         Debug.log "model" model
-                0
-
-            else
-                2
-
-        borderWidths =
-            if isSelected then
-                { left = 2, top = 2, right = 2, bottom = 0 }
-
-            else
-                { bottom = 2, top = 0, left = 0, right = 0 }
-
-        corners =
-            if isSelected then
-                { topLeft = 6, topRight = 6, bottomLeft = 0, bottomRight = 0 }
-
-            else
-                { topLeft = 0, topRight = 0, bottomLeft = 0, bottomRight = 0 }
     in
-    el
+    { title = "Prosody"
-        [ Border.widthEach borderWidths
+    , body = [ html ]
-        , Border.roundEach corners
+    }
-        , Border.color color.blue
-        , onClick <| UserSelectedTab tab
-        ]
-    <|
-        el
-            [ centerX
-            , centerY
-            , paddingEach { left = 30, right = 30, top = 10 + padOffset, bottom = 10 - padOffset }
-            ]
-        <|
-            text <|
-                case tab of
-                    Lessons ->
-                        "Lessons"
-
-                    Words ->
-                        "Words"
-
-                    Pronunciation ->
-                        "Audio"
 
 
-lessonsView : Lessons -> Element Msg
+init : flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
-lessonsView lessons =
+init flags url key =
-    Dict.values lessons
-        |> List.map lessonPreview
-        |> column []
-
-
-lessonPreview : Lesson -> Element Msg
-lessonPreview lesson =
-    el []
-        (column []
-            [ text ("Lesson: " ++ String.fromInt lesson.id)
-            , text lesson.text
-            ]
-        )
-
-
-init : flags -> ( Model, Cmd Msg )
-init flags =
     Debug.log "Init flags" flags
-        |> (\_ -> Debug.log "Initial State" initialState)
+        -- |> (\_ -> Debug.log "url" url)
-        |> (\_ -> ( initialState, fetchLessons FetchDataHandler ))
+        -- |> (\_ -> Debug.log "key" key)
+        -- |> (\_ -> Debug.log "Initial State" initialState)
+        |> (\_ -> ( initialState url key, fetchLessons ))
 
 
 main : Program () Model Msg
 main =
-    Browser.element
+    Browser.application
         { init = init
         , view = view
         , update = update
-        , subscriptions = \_ -> Sub.none
+        , subscriptions = subscriptions
+        , onUrlRequest = LinkClicked
+        , onUrlChange = UrlChanged
         }
 
 

ui/src/Router.elm

@@ -0,0 +1,61 @@
+module Router exposing (parseUrl, router)
+
+import Api exposing (fetchLesson)
+import Dict
+import Element exposing (..)
+import Homepage
+import Html exposing (Html)
+import Lessonpage
+import Types exposing (Model, Msg(..), Route(..))
+import Url
+import Url.Parser as Parser exposing ((</>), Parser)
+
+
+routeParser : Parser (Route -> a) a
+routeParser =
+    Parser.oneOf
+        [ Parser.map Root Parser.top
+        , Parser.map LessonR (Parser.s "lesson" </> Parser.int </> Parser.int)
+        ]
+
+
+parseUrl : Url.Url -> Route
+parseUrl url =
+    Parser.parse routeParser url |> Maybe.withDefault NotFound
+
+
+router : Model -> ( Model, Cmd Msg, Html Msg )
+router model =
+    case model.route of
+        Root ->
+            ( model, Cmd.none, Homepage.page model )
+
+        LessonR lid cid ->
+            lessonLoader lid cid model
+
+        NotFound ->
+            ( model, Cmd.none, notFound )
+
+
+lessonLoader : Int -> Int -> Model -> ( Model, Cmd Msg, Html Msg )
+lessonLoader lid cid model =
+    case Dict.get lid model.lessons of
+        Just lesson ->
+            ( model, Cmd.none, Lessonpage.page lesson cid )
+
+        Nothing ->
+            ( { model | isLoading = True }, fetchLesson lid, loadingPage )
+
+
+notFound : Html Msg
+notFound =
+    layout [] <|
+        el
+            [ centerX ]
+            (text "404")
+
+
+loadingPage : Html Msg
+loadingPage =
+    layout [] <|
+        el [ centerX, padding 20 ] (text "Loading lesson...")

ui/src/Types.elm

@@ -0,0 +1,53 @@
+module Types exposing (..)
+
+import Browser
+import Browser.Navigation as Nav
+import Dict exposing (Dict)
+import Http
+import Url
+
+
+type Route
+    = Root
+    | LessonR Int Int
+    | NotFound
+
+
+type alias Model =
+    { lessons : Lessons
+
+    -- , tab : Tab
+    , isLoading : Bool
+    , key : Nav.Key
+    , route : Route
+    }
+
+
+type ServerResponse t
+    = OkResponse t
+    | ErrorResponse String
+
+
+type Msg
+    = FetchLessons (Result Http.Error (ServerResponse Lessons))
+    | FetchLesson (Result Http.Error (ServerResponse Lesson))
+    | LinkClicked Browser.UrlRequest
+    | UrlChanged Url.Url
+
+
+type alias Card =
+    { text : String
+    , note : Maybe String
+    , id : Int
+    }
+
+
+type alias Lesson =
+    { text : String
+    , id : Int
+    , cards : List Card
+    }
+
+
+type alias Lessons =
+    Dict Int Lesson