Refactor fronted somewhat

frontend/Entry.elm

@@ -10,6 +10,9 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 
+import NumberInput
+import Select
+
 main = Browser.element
   { init = \globals ->
     ( Context globals <| ItemSearch { searchTerm = "", searchResults = [] }
@@ -85,11 +88,12 @@ type State
   | ItemEditor
     { barcode : String
     , name : String
-    , salesUnits : Int
+    , salesUnits : NumberInput.Model Int
-    , netUnitPrice : Float
+    , netUnitPrice : NumberInput.Model Float
-    , groupId : Int
+    , grossUnitPrice : NumberInput.Model Float
-    , locationId : Int
+    , group : Select.Model Group
-    , taxGroupId : Int
+    , location : Select.Model Location
+    , taxGroup : Select.Model TaxGroup
     }
 
 type Msg
@@ -97,13 +101,14 @@ type Msg
   | SubmitSearch
   | ReceiveSearchResults (Result Http.Error (List SearchResult))
   | GotoItemEditor SearchResult
-  | SetNetUnitPrice String
-  | SetGroupId String
-  | SetLocationId String
-  | SetTaxGroupId String
   | SetBarcode String
   | SetName String
   | SetSalesUnits String
+  | SetNetUnitPrice String
+  | SetGrossUnitPrice String
+  | SetGroup String
+  | SetLocation String
+  | SetTaxGroup String
 
 -- Update logic: State machine etc.
 
@@ -127,42 +132,52 @@ updateState msg globals state = case state of
     ReceiveSearchResults (Ok searchResults) ->
       (ItemSearch { model | searchResults = searchResults }, Cmd.none)
     GotoItemEditor searchResult ->
-      ( ItemEditor
+      case find (\tg -> tg.id == searchResult.taxGroupId) globals.taxGroups of
-        { barcode = searchResult.barcode
+        Nothing -> (state, Cmd.none)
-        , groupId = searchResult.groupId
+        Just taxGroup ->
-        , locationId = searchResult.locationId
+          ( ItemEditor
-        , name = searchResult.name
+            { barcode = searchResult.barcode
-        , netUnitPrice = searchResult.netUnitPrice
+            , name = searchResult.name
-        , salesUnits = searchResult.salesUnits
+            , netUnitPrice = NumberInput.fromFloat searchResult.netUnitPrice
-        , taxGroupId = searchResult.taxGroupId
+            , grossUnitPrice = NumberInput.fromFloat <| calculateGarfieldPrice searchResult.netUnitPrice taxGroup.percentage
-        }
+            , salesUnits = NumberInput.fromInt searchResult.salesUnits
-      , Cmd.none
+            , group = Select.init (.id >> String.fromInt) (.name) { id = searchResult.groupId, name = searchResult.groupName } globals.groups
-      )
+            , location = Select.init (.id >> String.fromInt) (.name) { id = searchResult.locationId, name = searchResult.locationName } globals.locations
+            , taxGroup = Select.init (.id >> String.fromInt) (.description) taxGroup globals.taxGroups
+            }
+          , Cmd.none
+          )
     _ ->
       (state, Cmd.none)
   ItemEditor model -> case msg of
-    SetNetUnitPrice netUnitPriceStr -> case String.toFloat netUnitPriceStr of
-      Nothing -> (state, Cmd.none)
-      Just netUnitPrice -> (ItemEditor { model | netUnitPrice = netUnitPrice }, Cmd.none)
-    SetGroupId groupIdStr -> case String.toInt groupIdStr of
-      Nothing -> (state, Cmd.none)
-      Just groupId -> (ItemEditor { model | groupId = groupId }, Cmd.none)
-    SetLocationId locationIdStr -> case String.toInt locationIdStr of
-      Nothing -> (state, Cmd.none)
-      Just locationId -> (ItemEditor { model | locationId = locationId }, Cmd.none)
-    SetTaxGroupId taxGroupIdStr -> case String.toInt taxGroupIdStr of
-      Nothing -> (state, Cmd.none)
-      Just taxGroupId -> (ItemEditor { model | taxGroupId = taxGroupId }, Cmd.none)
     SetBarcode barcode ->
       (ItemEditor { model | barcode = barcode }, Cmd.none)
     SetName name ->
       (ItemEditor { model | name = name }, Cmd.none)
-    SetSalesUnits salesUnitsStr -> case String.toInt salesUnitsStr of
+    SetSalesUnits str ->
-      Nothing -> (state, Cmd.none)
+      (ItemEditor { model | salesUnits = NumberInput.update str model.salesUnits }, Cmd.none)
-      Just salesUnits -> (ItemEditor { model | salesUnits = salesUnits }, Cmd.none)
+    SetNetUnitPrice str ->
+      ( ItemEditor <| updateGrossUnitPrice { model | netUnitPrice = NumberInput.update str model.netUnitPrice }
+      , Cmd.none
+      )
+    SetGrossUnitPrice str ->
+      (ItemEditor { model | grossUnitPrice = NumberInput.update str model.grossUnitPrice }, Cmd.none)
+    SetGroup key ->
+      (ItemEditor { model | group = Select.update key model.group }, Cmd.none)
+    SetLocation key ->
+      (ItemEditor { model | location = Select.update key model.location }, Cmd.none)
+    SetTaxGroup key ->
+      ( ItemEditor <| updateGrossUnitPrice { model | taxGroup = Select.update key model.taxGroup }
+      , Cmd.none
+      )
     _ ->
       (state, Cmd.none)
 
+updateGrossUnitPrice model =
+  { model
+  | grossUnitPrice = NumberInput.fromFloat <| calculateGarfieldPrice (NumberInput.get model.netUnitPrice) (Select.get model.taxGroup).percentage
+  }
+
 -- View stuff
 
 view { globals, state } = case state of
@@ -177,80 +192,60 @@ view { globals, state } = case state of
         , table [] <| searchResultHeaders :: List.map viewSearchResult model.searchResults
         ]
       ]
-  ItemEditor model -> case find (\tg -> tg.id == model.taxGroupId) globals.taxGroups of
+  ItemEditor model ->
-    Nothing -> div [] [ text "index error, this should never happen" ]
+    Html.form []
-    Just selectedTaxGroup ->
+      [ fieldset []
-      Html.form []
+        [ legend [] [ text "Neuer Inventareintrag" ]
-        [ fieldset []
+        , div [ class "form-input" ]
-          [ legend [] [ text "Neuer Inventareintrag" ]
+          [ label [ for "barcode" ] [ text "Barcode" ]
-          , div [ class "form-input" ]
+          , input [ onInput SetBarcode, value model.barcode, disabled True, id "barcode" ] []
-            [ label [ for "barcode" ] [ text "Barcode" ]
-            , input [ onInput SetBarcode, value model.barcode, disabled True, id "barcode" ] []
-            ]
-          , div [ class "form-input" ]
-            [ label [ for "name" ] [ text "Name" ]
-            , input [ onInput SetName, value model.name, id "name" ] []
-            ]
-          , div [ class "form-input" ]
-            [ label [ for "sales-units" ] [ text "Stückzahl" ]
-            , input [ onInput SetSalesUnits, value <| String.fromInt model.salesUnits, id "sales-units", type_ "number" ] []
-            ]
-          , div [ class "form-input" ]
-            [ label [ for "group" ] [ text "Gruppe" ]
-            , viewSelect
-              [ onInput SetGroupId, id "group" ]
-              String.fromInt .id .name model.groupId globals.groups
-            ]
-          , div [ class "form-input" ]
-            [ label [ for "location" ] [ text "Raum" ]
-            , viewSelect
-              [ onInput SetLocationId, id "location" ]
-              String.fromInt .id .name model.locationId globals.locations
-            ]
-          , div [ class "form-input" ]
-            [ label [ for "net-unit-price" ] [ text "Stückpreis (Netto)" ]
-            , input
-              [ value <| String.fromFloat model.netUnitPrice
-              , onInput SetNetUnitPrice
-              , type_ "number"
-              , id "net-unit-price"
-              , step "0.01"
-              ]
-              []
-            ]
-          , div [ class "form-input" ]
-            [ label [ for "tax-group" ] [ text "Steuergruppe" ]
-            , viewSelect
-              [ onInput SetTaxGroupId, id "tax-group" ]
-              String.fromInt .id .description model.taxGroupId globals.taxGroups
-            ]
           ]
-        , fieldset []
+        , div [ class "form-input" ]
-          [ legend [] [ text "Neuer Snackeintrag" ]
+          [ label [ for "name" ] [ text "Name" ]
-          , div [ class "form-input" ]
+          , input [ onInput SetName, value model.name, id "name" ] []
-            [ label [ for "snack-name" ] [ text "Name" ]
+          ]
-            , input [ value model.name, disabled True, id "snack-name" ] []
+        , div [ class "form-input" ]
-            ]
+          [ label [ for "sales-units" ] [ text "Stückzahl" ]
-          , div [ class "form-input" ]
+          , input [ onInput SetSalesUnits, value <| NumberInput.show model.salesUnits, id "sales-units", type_ "number" ] []
-            [ label [ for "gross-unit-price" ]
+          ]
-              [ text <| "Stückpreis (Brutto), Vorschlag: " ++ String.fromFloat (calculateGarfieldPrice model.netUnitPrice selectedTaxGroup.percentage)
+        , div [ class "form-input" ]
-              ]
+          [ label [ for "group" ] [ text "Gruppe" ]
-            , input [ value <| String.fromFloat <| Maybe.withDefault (calculateGarfieldPrice model.netUnitPrice selectedTaxGroup.percentage) Nothing, id "gross-unit-price", type_ "number", step "0.01" ] []
+          , Select.view SetGroup model.group
+          ]
+        , div [ class "form-input" ]
+          [ label [ for "location" ] [ text "Raum" ]
+          , Select.view SetLocation model.location
+          ]
+        , div [ class "form-input" ]
+          [ label [ for "net-unit-price" ] [ text "Stückpreis (Netto)" ]
+          , input
+            [ value <| NumberInput.show model.netUnitPrice
+            , onInput SetNetUnitPrice
+            , type_ "number"
+            , id "net-unit-price"
+            , step "0.01"
             ]
+            []
+          ]
+        , div [ class "form-input" ]
+          [ label [ for "tax-group" ] [ text "Steuergruppe" ]
+          , Select.view SetTaxGroup model.taxGroup
           ]
         ]
-
+      , fieldset []
-viewSelect selectAttributes showValue getValue getLabel selectedValue xs =
+        [ legend [] [ text "Neuer Snackeintrag" ]
-  let
+        , div [ class "form-input" ]
-    viewOption x =
+          [ label [ for "snack-name" ] [ text "Name" ]
-      option
+          , input [ value model.name, disabled True, id "snack-name" ] []
-        [ value <| showValue <| getValue x
+          ]
-        , selected <| getValue x == selectedValue
+        , div [ class "form-input" ]
+          [ label [ for "gross-unit-price" ]
+            [ text <| "Stückpreis (Brutto), Vorschlag: " ++ String.fromFloat (calculateGarfieldPrice (NumberInput.get model.netUnitPrice) (Select.get model.taxGroup).percentage)
+            ]
+          , input [ onInput SetGrossUnitPrice, value <| NumberInput.show model.grossUnitPrice, id "gross-unit-price", type_ "number", step "0.01" ] []
+          ]
         ]
-        [ text <| getLabel x
+      ]
-        ]
-  in
-    select selectAttributes <| List.map viewOption xs
 
 searchResultHeaders =
   tr []

frontend/NumberInput.elm

@@ -0,0 +1,25 @@
+module NumberInput exposing (..)
+
+type alias Model a =
+  { value : a
+  , original : String
+  , convert : String -> Maybe a
+  }
+
+fromFloat : Float -> Model Float
+fromFloat x = Model x (String.fromFloat x) String.toFloat
+
+fromInt : Int -> Model Int
+fromInt x = Model x (String.fromInt x) String.toInt
+
+get : Model a -> a
+get = .value
+
+update : String -> Model a -> Model a
+update str model =
+  case model.convert str of
+    Nothing -> model
+    Just value -> { model | value = value, original = str }
+
+show : Model a -> String
+show = .original

frontend/Select.elm

@@ -0,0 +1,36 @@
+module Select exposing (..)
+
+import Html exposing (Html, option, select, text)
+import Html.Attributes exposing (selected, value)
+import Html.Events exposing (onInput)
+
+type alias Model a =
+  { identify : a -> String
+  , show : a -> String
+  , selected : a
+  , options : List a
+  }
+
+init : (a -> String) -> (a -> String) -> a -> List a -> Model a
+init = Model
+
+update : String -> Model a -> Model a
+update key model =
+  case find (\x -> key == model.identify x) model.options of
+    Nothing -> model
+    Just x -> { model | selected = x }
+
+view : (String -> m) -> Model a -> Html m
+view msg model =
+  let
+    viewOption x =
+      option
+        [ selected <| model.identify model.selected == model.identify x, value <| model.identify x ]
+        [ text <| model.show x ]
+  in
+    select [ onInput msg ] <| List.map viewOption model.options
+
+get : Model a -> a
+get = .selected
+
+find pred xs = List.head <| List.filter pred xs