WS-442 | WMS reusable code (#71)

* Bump PaackEng/paack-ui from 7.8.1 to 7.9.0 in /example Bumps [PaackEng/paack-ui](https://github.com/PaackEng/paack-ui) from 7.8.1 to 7.9.0. - [Release notes](https://github.com/PaackEng/paack-ui/releases) - [Commits](PaackEng/paack-ui@7.8.1...7.9.0) --- updated-dependencies: - dependency-name: PaackEng/paack-ui dependency-type: direct:production update-type: version-update:semver-minor ... Signed-off-by: dependabot[bot] <[email protected]> * Bump esbuild from 0.14.0 to 0.14.1 Bumps [esbuild](https://github.com/evanw/esbuild) from 0.14.0 to 0.14.1. - [Release notes](https://github.com/evanw/esbuild/releases) - [Changelog](https://github.com/evanw/esbuild/blob/master/CHANGELOG.md) - [Commits](evanw/esbuild@v0.14.0...v0.14.1) --- updated-dependencies: - dependency-name: esbuild dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] <[email protected]> * Add loadUrl effect * Add reusable code from WMS * Apply elm-format * Remove Paack.Remote * Remove legacy Paack.Basics.Extra * Add reusable code from LMO * Add indicator to what kind of request is being made * Fix review issues * Bump to 3.0.0 Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
PaackEng · Dec 22, 2021 · 3b3cefb · 3b3cefb
1 parent cfef3da
commit 3b3cefb
Show file tree

Hide file tree

Showing 17 changed files with 397 additions and 130 deletions.
diff --git a/elm/Paack/Basics.elm b/elm/Paack/Basics.elm
@@ -0,0 +1,15 @@
+module Paack.Basics.Extra exposing (flip, ifThenElse, maybePrepend)
+
+
+flip : (a -> b -> c) -> b -> a -> c
+flip applier b a =
+    applier a b
+
+
+ifThenElse : Bool -> a -> a -> a
+ifThenElse condition ifThen ifElse =
+    if condition then
+        ifThen
+
+    else
+        ifElse
diff --git a/elm/Paack/Basics/Extra.elm b/elm/Paack/Basics/Extra.elm
diff --git a/elm/Paack/DateFormat.elm b/elm/Paack/DateFormat.elm
@@ -0,0 +1,73 @@
+module Paack.DateFormat exposing (..)
+
+import DateFormat exposing (..)
+import Time
+
+
+fullStamp : List Token
+fullStamp =
+    [ dayOfMonthFixed
+    , DateFormat.text "/"
+    , monthFixed
+    , DateFormat.text "/"
+    , yearNumberLastTwo
+    , DateFormat.text " "
+    , hourMilitaryFixed
+    , DateFormat.text ":"
+    , minuteFixed
+    ]
+
+
+dateOnly : List Token
+dateOnly =
+    [ dayOfMonthFixed
+    , DateFormat.text "/"
+    , monthFixed
+    , DateFormat.text "/"
+    , yearNumberLastTwo
+    ]
+
+
+timeOnly : List Token
+timeOnly =
+    [ hourMilitaryFixed
+    , DateFormat.text ":"
+    , minuteFixed
+    ]
+
+
+shortMonthDayYear : List Token
+shortMonthDayYear =
+    [ monthNameAbbreviated
+    , text " "
+    , DateFormat.dayOfMonthFixed
+    , text ", "
+    , yearNumber
+    ]
+
+
+sortableTime : Time.Posix -> String
+sortableTime time =
+    format
+        [ yearNumber
+        , DateFormat.text "-"
+        , monthFixed
+        , DateFormat.text "-"
+        , dayOfMonthFixed
+        , DateFormat.text "-"
+        , hourMilitaryFixed
+        , DateFormat.text "-"
+        , minuteFixed
+        ]
+        Time.utc
+        time
+
+
+sortableDate : List Token
+sortableDate =
+    [ yearNumber
+    , DateFormat.text "-"
+    , monthFixed
+    , DateFormat.text "-"
+    , dayOfMonthFixed
+    ]
diff --git a/elm/Paack/Dict.elm b/elm/Paack/Dict.elm
@@ -0,0 +1,17 @@
+module Paack.Dict exposing (toggle)
+
+import Dict exposing (Dict)
+
+
+toggle : comparable -> object -> Dict comparable object -> Dict comparable object
+toggle key value dict =
+    Dict.update key
+        (\past ->
+            case past of
+                Just _ ->
+                    Nothing
+
+                Nothing ->
+                    Just value
+        )
+        dict
diff --git a/elm/Paack/Effects.elm b/elm/Paack/Effects.elm
@@ -2,7 +2,7 @@ module Paack.Effects exposing
     ( Effects, fromLocal
     , none, batch, map
     , loopMsg
-    , pushUrl, replaceUrl, timeHere, domFocus, domGetElement, domSetViewportOf
+    , loadUrl, pushUrl, replaceUrl, timeHere, domFocus, domGetElement, domSetViewportOf
     , uuidGenerator, httpRequest, paackUI
     , graphqlQuery, graphqlMutation
     , Effect(..), apply
@@ -24,7 +24,7 @@ module Paack.Effects exposing
 # Common Effects
 
 @docs loopMsg
-@docs pushUrl, replaceUrl, timeHere, domFocus, domGetElement, domSetViewportOf
+@docs loadUrl, pushUrl, replaceUrl, timeHere, domFocus, domGetElement, domSetViewportOf
 @docs uuidGenerator, httpRequest, paackUI
 @docs graphqlQuery, graphqlMutation
 
@@ -102,6 +102,11 @@ mapEffects applier sideEffects =
 -- Common side effects
 
 
+loadUrl : String -> Effects msg
+loadUrl =
+    Common.loadUrl >> fromCommon
+
+
 pushUrl : String -> Effects msg
 pushUrl =
     Common.pushUrl >> fromCommon

diff --git a/elm/Paack/Effects/Common.elm b/elm/Paack/Effects/Common.elm
@@ -1,7 +1,7 @@
 module Paack.Effects.Common exposing
     ( CommonEffect(..), mapCommonEffect
     , loopMsg
-    , pushUrl, replaceUrl, timeHere, domGetElement, domSetViewportOf, domFocus
+    , loadUrl, pushUrl, replaceUrl, timeHere, domGetElement, domSetViewportOf, domFocus
     , uuidGenerator, httpRequest
     , GraphqlRequestEffect, HttpRequestEffect, graphqlQuery, graphqlMutation
     )
@@ -17,7 +17,7 @@ module Paack.Effects.Common exposing
 # Common Effectss
 
 @docs loopMsg
-@docs pushUrl, replaceUrl, timeHere, domGetElement, domSetViewportOf, domFocus
+@docs loadUrl, pushUrl, replaceUrl, timeHere, domGetElement, domSetViewportOf, domFocus
 @docs uuidGenerator, httpRequest
 @docs GraphqlRequestEffect, HttpRequestEffect, graphqlQuery, graphqlMutation
 
@@ -37,6 +37,7 @@ import UUID exposing (UUID, decoder)
 
 type CommonEffect msg
     = LoopMsg msg
+    | LoadUrl String
     | PushUrl String
     | ReplaceUrl String
     | TimeHere (Time.Zone -> msg)
@@ -74,6 +75,9 @@ mapCommonEffect fn effect =
         LoopMsg msg ->
             LoopMsg <| fn msg
 
+        LoadUrl url ->
+            LoadUrl url
+
         PushUrl url ->
             PushUrl url
 
@@ -123,6 +127,11 @@ mapCommonEffect fn effect =
                 }
 
 
+loadUrl : String -> CommonEffect msg
+loadUrl =
+    LoadUrl
+
+
 pushUrl : String -> CommonEffect msg
 pushUrl =
     PushUrl

diff --git a/elm/Paack/Effects/CommonPerformer.elm b/elm/Paack/Effects/CommonPerformer.elm
@@ -19,6 +19,9 @@ effectPerform key seeds effect =
             , Task.perform identity <| Task.succeed msg
             )
 
+        LoadUrl url ->
+            ( seeds, Nav.load url )
+
         PushUrl url ->
             ( seeds
             , Nav.pushUrl key url

diff --git a/elm/Paack/Effects/CommonSimulator.elm b/elm/Paack/Effects/CommonSimulator.elm
@@ -19,6 +19,9 @@ effectPerform index effect =
         LoopMsg msg ->
             loop msg
 
+        LoadUrl url ->
+            Nav.load url
+
         PushUrl url ->
             Nav.pushUrl url
 
@@ -71,7 +74,7 @@ httpRequest index data =
 graphqlHttpQuery : Int -> GraphqlRequestEffect RootQuery msg -> SimulatedEffect msg
 graphqlHttpQuery index data =
     ElmHttp.post
-        { url = data.url ++ "#i" ++ String.fromInt index
+        { url = data.url ++ "#q" ++ String.fromInt index
         , body = ElmHttp.emptyBody
         , expect = graphqlExpect data
         }
@@ -80,7 +83,7 @@ graphqlHttpQuery index data =
 graphqlHttpMutation : Int -> GraphqlRequestEffect RootMutation msg -> SimulatedEffect msg
 graphqlHttpMutation index data =
     ElmHttp.post
-        { url = data.url ++ "#i" ++ String.fromInt index
+        { url = data.url ++ "#m" ++ String.fromInt index
         , body = ElmHttp.emptyBody
         , expect = graphqlExpect data
         }

diff --git a/elm/Paack/Either.elm b/elm/Paack/Either.elm
@@ -0,0 +1,26 @@
+module Paack.Either exposing (..)
+
+
+type Either a b
+    = Left a
+    | Right b
+
+
+fromResult : Result error value -> Either error value
+fromResult result =
+    case result of
+        Ok value ->
+            Right value
+
+        Err error ->
+            Left error
+
+
+toResult : Either error value -> Result error value
+toResult either =
+    case either of
+        Right value ->
+            Ok value
+
+        Left error ->
+            Err error
diff --git a/elm/Paack/Events.elm b/elm/Paack/Events.elm
@@ -0,0 +1,20 @@
+module Paack.Events exposing (onEscapeKey)
+
+import Browser.Events as Events
+import Json.Decode as Decode
+
+
+onEscapeKey : msg -> Sub msg
+onEscapeKey msg =
+    Decode.string
+        |> Decode.field "key"
+        |> Decode.andThen
+            (\key ->
+                case key of
+                    "Escape" ->
+                        Decode.succeed msg
+
+                    _ ->
+                        Decode.fail "Irrelevant key"
+            )
+        |> Events.onKeyUp
diff --git a/elm/Paack/Json/Encode.elm b/elm/Paack/Json/Encode.elm
@@ -0,0 +1,13 @@
+module Paack.Json.Encode exposing (..)
+
+import Json.Encode as Encode exposing (Value)
+
+
+maybeWithNull : (data -> Value) -> Maybe data -> Value
+maybeWithNull encoder maybeData =
+    case maybeData of
+        Just data ->
+            encoder data
+
+        Nothing ->
+            Encode.null
diff --git a/elm/Paack/List.elm b/elm/Paack/List.elm
@@ -0,0 +1,72 @@
+module Paack.List exposing (..)
+
+import UUID exposing (UUID)
+
+
+unique : List comparable -> List comparable
+unique =
+    Set.fromList >> Set.toList
+
+
+find : (a -> Bool) -> List a -> Maybe a
+find predicate list =
+    case list of
+        [] ->
+            Nothing
+
+        head :: tail ->
+            if predicate head then
+                Just head
+
+            else
+                find predicate tail
+
+
+findById : UUID -> List { a | id : UUID } -> Maybe { a | id : UUID }
+findById uuid =
+    find (.id >> (==) uuid)
+
+
+insert : { a | id : UUID } -> List { a | id : UUID } -> List { a | id : UUID }
+insert item list =
+    list
+        |> List.filter (.id >> (/=) item.id)
+        |> (::) item
+
+
+updateById : UUID -> ({ a | id : UUID } -> { a | id : UUID }) -> List { a | id : UUID } -> List { a | id : UUID }
+updateById uuid applier list =
+    List.map
+        (\item ->
+            if item.id == uuid then
+                applier item
+
+            else
+                item
+        )
+        list
+
+
+prependMaybe : Maybe a -> List a -> List a
+prependMaybe maybeSomething items =
+    case maybeSomething of
+        Just something ->
+            something :: items
+
+        Nothing ->
+            items
+
+
+mapHead : (a -> Maybe b) -> List a -> Maybe b
+mapHead filterMap list =
+    case list of
+        [] ->
+            Nothing
+
+        head :: tail ->
+            case filterMap head of
+                Just match ->
+                    Just match
+
+                Nothing ->
+                    mapHead filterMap tail
diff --git a/elm/Paack/Maybe.elm b/elm/Paack/Maybe.elm
@@ -0,0 +1,11 @@
+module Paack.Maybe exposing (fallback)
+
+
+fallback : Maybe a -> Maybe a -> Maybe a
+fallback replacement primary =
+    case primary of
+        Just _ ->
+            primary
+
+        Nothing ->
+            replacement