Changes
3 changed files (+375/-374)
-
-
@@ -9,7 +9,9 @@module Parameters exposing (..) import Length exposing (Length, mm) import Dict exposing (Dict) import Length exposing (Length, mm, toMM) import Parameters.Key as Key exposing (Key(..)) type TipShape
-
@@ -218,3 +220,70 @@ , lineWidth = mm 0.3, colorSchema = BlackOnWhite } } type alias ParametersDict = Dict String String toDict : Parameters -> Dict String String toDict params = [ Just ( Key.toString LugWidth, String.fromFloat (toMM params.lugWidth) ) , Just ( Key.toString SurfaceThickness, String.fromFloat (toMM params.thickness) ) , Just ( Key.toString LiningThickness, String.fromFloat (toMM params.lining) ) , Just ( Key.toString BuckleHoleOffset, String.fromFloat (toMM params.longPiece.buckleHole.offset) ) , Just ( Key.toString BuckleHoleCount, String.fromInt params.longPiece.buckleHole.count ) , Just ( Key.toString BuckleHoleInterval, String.fromFloat (toMM params.longPiece.buckleHole.interval) ) , Just ( Key.toString BuckleHoleDiameter, String.fromFloat (toMM params.longPiece.buckleHole.diameter) ) , Just ( Key.toString LongPieceLength, String.fromFloat (toMM params.longPiece.length) ) , Just ( Key.toString LoopThickness, String.fromFloat (toMM params.shortPiece.loops.thickness) ) , Just ( Key.toString LoopStyle, loopStyleToString params.shortPiece.loops.style ) , params.shortPiece.loops.fixed |> Maybe.map (\_ -> ( Key.toString HasFixedLoop, "" )) , Just ( Key.toString FixedLoopWidth , params.shortPiece.loops.fixed |> Maybe.withDefault defaultFixedLoop |> .width |> toMM |> String.fromFloat ) , Just ( Key.toString FixedLoopPlay , params.shortPiece.loops.fixed |> Maybe.withDefault defaultFixedLoop |> .play |> toMM |> String.fromFloat ) , params.shortPiece.loops.free |> Maybe.map (\_ -> ( Key.toString HasFreeLoop, "" )) , Just ( Key.toString FreeLoopWidth , params.shortPiece.loops.free |> Maybe.withDefault defaultFreeLoop |> .width |> toMM |> String.fromFloat ) , Just ( Key.toString FreeLoopPlay , params.shortPiece.loops.free |> Maybe.withDefault defaultFreeLoop |> .play |> toMM |> String.fromFloat ) , Just ( Key.toString FreeLoopOverlap , params.shortPiece.loops.free |> Maybe.withDefault defaultFreeLoop |> .overlap |> toMM |> String.fromFloat ) , Just ( Key.toString BuckleSpringBarDiameter, String.fromFloat (toMM params.shortPiece.buckle.springBarDiameter) ) , params.shortPiece.buckle.tongue |> Maybe.map (\_ -> ( Key.toString HasBuckleTongue, "" )) , Just ( Key.toString BuckleTongueThickness , params.shortPiece.buckle.tongue |> Maybe.withDefault defaultBuckleTongue |> .thickness |> toMM |> String.fromFloat ) , Just ( Key.toString BuckleTongueWidth , params.shortPiece.buckle.tongue |> Maybe.withDefault defaultBuckleTongue |> .width |> toMM |> String.fromFloat ) , Just ( Key.toString ShortPieceLength, String.fromFloat (toMM params.shortPiece.length) ) , Just ( Key.toString CanvasMargin, String.fromFloat (toMM params.rendering.margin) ) , Just ( Key.toString LineWidth, String.fromFloat (toMM params.rendering.lineWidth) ) , Just ( Key.toString ColorSchema, colorSchemaToString params.rendering.colorSchema ) ] |> List.filterMap identity |> Dict.fromList getKey : Key -> ParametersDict -> Maybe String getKey key fields = Dict.get (Key.toString key) fields hasKey : Key -> ParametersDict -> Bool hasKey key fields = not (getKey key fields == Nothing)
-
-
-
@@ -9,13 +9,13 @@module Parameters.App exposing (Model, Msg, init, update, view) import Dict exposing (Dict) import Dict import Html exposing (hr, input, label, node, p, span, text) import Html.Attributes exposing (..) import Html.Events exposing (onBlur, onFocus, onInput) import Html.LivingStandard exposing (..) import Length exposing (Length, toMM) import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, colorSchemaToString, defaultBuckleTongue, defaultFixedLoop, defaultFreeLoop, loopStyleToString) import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, colorSchemaToString, getKey, hasKey, loopStyleToString) import Parameters.Constraints exposing (NumberConstraints, constraints) import Parameters.Key as Key exposing (Key(..)) import Parameters.Parser exposing (..)
-
@@ -24,18 +24,10 @@-- MODEL type alias Fields = Dict String String type alias Errors = Dict String Error type alias Model = { fields : Fields { fields : ParametersDict , errors : Errors , parameters : Parameters , highlighting : Maybe Key
-
@@ -46,55 +38,7 @@ init : Parameters -> Modelinit params = let fields = [ Just ( Key.toString LugWidth, String.fromFloat (toMM params.lugWidth) ) , Just ( Key.toString SurfaceThickness, String.fromFloat (toMM params.thickness) ) , Just ( Key.toString LiningThickness, String.fromFloat (toMM params.lining) ) , Just ( Key.toString BuckleHoleOffset, String.fromFloat (toMM params.longPiece.buckleHole.offset) ) , Just ( Key.toString BuckleHoleCount, String.fromInt params.longPiece.buckleHole.count ) , Just ( Key.toString BuckleHoleInterval, String.fromFloat (toMM params.longPiece.buckleHole.interval) ) , Just ( Key.toString BuckleHoleDiameter, String.fromFloat (toMM params.longPiece.buckleHole.diameter) ) , Just ( Key.toString LongPieceLength, String.fromFloat (toMM params.longPiece.length) ) , Just ( Key.toString LoopThickness, String.fromFloat (toMM params.shortPiece.loops.thickness) ) , Just ( Key.toString LoopStyle, loopStyleToString params.shortPiece.loops.style ) , params.shortPiece.loops.fixed |> Maybe.map (\_ -> ( Key.toString HasFixedLoop, "" )) , Just ( Key.toString FixedLoopWidth , params.shortPiece.loops.fixed |> Maybe.withDefault defaultFixedLoop |> .width |> toMM |> String.fromFloat ) , Just ( Key.toString FixedLoopPlay , params.shortPiece.loops.fixed |> Maybe.withDefault defaultFixedLoop |> .play |> toMM |> String.fromFloat ) , params.shortPiece.loops.free |> Maybe.map (\_ -> ( Key.toString HasFreeLoop, "" )) , Just ( Key.toString FreeLoopWidth , params.shortPiece.loops.free |> Maybe.withDefault defaultFreeLoop |> .width |> toMM |> String.fromFloat ) , Just ( Key.toString FreeLoopPlay , params.shortPiece.loops.free |> Maybe.withDefault defaultFreeLoop |> .play |> toMM |> String.fromFloat ) , Just ( Key.toString FreeLoopOverlap , params.shortPiece.loops.free |> Maybe.withDefault defaultFreeLoop |> .overlap |> toMM |> String.fromFloat ) , Just ( Key.toString BuckleSpringBarDiameter, String.fromFloat (toMM params.shortPiece.buckle.springBarDiameter) ) , params.shortPiece.buckle.tongue |> Maybe.map (\_ -> ( Key.toString HasBuckleTongue, "" )) , Just ( Key.toString BuckleTongueThickness , params.shortPiece.buckle.tongue |> Maybe.withDefault defaultBuckleTongue |> .thickness |> toMM |> String.fromFloat ) , Just ( Key.toString BuckleTongueWidth , params.shortPiece.buckle.tongue |> Maybe.withDefault defaultBuckleTongue |> .width |> toMM |> String.fromFloat ) , Just ( Key.toString ShortPieceLength, String.fromFloat (toMM params.shortPiece.length) ) , Just ( Key.toString CanvasMargin, String.fromFloat (toMM params.rendering.margin) ) , Just ( Key.toString LineWidth, String.fromFloat (toMM params.rendering.lineWidth) ) , Just ( Key.toString ColorSchema, colorSchemaToString params.rendering.colorSchema ) ] |> List.filterMap identity |> Dict.fromList Parameters.toDict params in { fields = fields , errors =
-
@@ -121,289 +65,6 @@ | Highlight Key| Unhighlight Key parseField : Key -> (String -> Result Error a) -> Fields -> Result Error a parseField key f fields = Dict.get (Key.toString key) fields |> Maybe.withDefault "" |> f mkErrors : List ( Key, Maybe Error ) -> Errors mkErrors list = list |> List.filterMap (\( key, error ) -> Maybe.map (\e -> ( Key.toString key, e )) error) |> Dict.fromList getError : Result a b -> Maybe a getError r = case r of Err e -> Just e _ -> Nothing hasField : Key -> Fields -> Bool hasField key fields = not (Dict.get (Key.toString key) fields == Nothing) parseFixedLoop : Fields -> Result Errors (Maybe Parameters.FixedLoop) parseFixedLoop fields = if hasField HasFixedLoop fields then case ( parseField FixedLoopWidth (parseLength constraints.shortPiece.loops.fixed.width) fields , parseField FixedLoopPlay (parseLength constraints.shortPiece.loops.fixed.play) fields ) of ( Ok width, Ok play ) -> let base = Parameters.defaultFixedLoop in Ok (Just { base | width = width, play = play }) ( width, play ) -> Err (mkErrors [ ( FixedLoopWidth, getError width ) , ( FixedLoopPlay, getError play ) ] ) else Ok Nothing parseFreeLoop : Fields -> Result Errors (Maybe Parameters.FreeLoop) parseFreeLoop fields = if hasField HasFreeLoop fields then case ( parseField FreeLoopWidth (parseLength constraints.shortPiece.loops.free.width) fields , parseField FreeLoopPlay (parseLength constraints.shortPiece.loops.free.play) fields , parseField FreeLoopOverlap (parseLength constraints.shortPiece.loops.free.overlap) fields ) of ( Ok width, Ok play, Ok overlap ) -> Ok (Just { width = width, play = play, overlap = overlap }) ( width, play, overlap ) -> Err (mkErrors [ ( FreeLoopWidth, getError width ) , ( FreeLoopPlay, getError play ) , ( FreeLoopOverlap, getError overlap ) ] ) else Ok Nothing parseLoops : Fields -> Result Errors Parameters.Loops parseLoops fields = case ( ( parseFixedLoop fields, parseFreeLoop fields ) , ( parseField LoopStyle parseLoopStyle fields , parseField LoopThickness (parseLength constraints.shortPiece.loops.thickness) fields ) ) of ( ( Ok fixed, Ok free ), ( Ok style, Ok thickness ) ) -> Ok { fixed = fixed, free = free, style = style, thickness = thickness } ( ( fixed, free ), ( style, thickness ) ) -> [ getError fixed |> Maybe.withDefault Dict.empty , getError free |> Maybe.withDefault Dict.empty , mkErrors [ ( LoopStyle, getError style ), ( LoopThickness, getError thickness ) ] ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err parseBuckleTongue : Fields -> Result Errors (Maybe Parameters.BuckleTongue) parseBuckleTongue fields = if hasField HasBuckleTongue fields then case ( parseField BuckleTongueWidth (parseLength constraints.shortPiece.buckle.tongue.width) fields , parseField BuckleTongueThickness (parseLength constraints.shortPiece.buckle.tongue.thickness) fields ) of ( Ok width, Ok thickness ) -> Ok (Just { width = width, thickness = thickness }) ( width, thickness ) -> Err (mkErrors [ ( BuckleTongueWidth, getError width ) , ( BuckleTongueThickness, getError thickness ) ] ) else Ok Nothing parseBuckle : Fields -> Result Errors Parameters.Buckle parseBuckle fields = case ( parseBuckleTongue fields , parseField BuckleSpringBarDiameter (parseLength constraints.shortPiece.buckle.springBarDiameter) fields ) of ( Ok tongue, Ok springBarDiameter ) -> Ok { tongue = tongue, springBarDiameter = springBarDiameter } ( tongue, springBarDiameter ) -> [ getError tongue |> Maybe.withDefault Dict.empty , mkErrors [ ( BuckleSpringBarDiameter, getError springBarDiameter ) ] ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err parseShortPiece : Fields -> Result Errors Parameters.ShortPiece parseShortPiece fields = case ( parseLoops fields , parseField ShortPieceLength (parseLength constraints.shortPiece.length) fields , parseBuckle fields ) of ( Ok loops, Ok length, Ok buckle ) -> let base = Parameters.default.shortPiece in Ok { base | loops = loops, length = length, buckle = buckle } ( loops, length, buckle ) -> [ getError loops |> Maybe.withDefault Dict.empty , mkErrors [ ( ShortPieceLength, getError length ) ] , getError buckle |> Maybe.withDefault Dict.empty ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err parseBuckleHole : Fields -> Result Errors Parameters.BuckleHole parseBuckleHole fields = case ( ( parseField BuckleHoleCount (parseInt constraints.longPiece.buckleHole.count) fields , parseField BuckleHoleDiameter (parseLength constraints.longPiece.buckleHole.diameter) fields ) , ( parseField BuckleHoleOffset (parseLength constraints.longPiece.buckleHole.offset) fields , parseField BuckleHoleInterval (parseLength constraints.longPiece.buckleHole.interval) fields ) ) of ( ( Ok count, Ok diameter ), ( Ok offset, Ok interval ) ) -> Ok { count = count, diameter = diameter, offset = offset, interval = interval } ( ( count, diameter ), ( offset, interval ) ) -> Err (mkErrors [ ( BuckleHoleCount, getError count ) , ( BuckleHoleDiameter, getError diameter ) , ( BuckleHoleOffset, getError offset ) , ( BuckleHoleInterval, getError interval ) ] ) parseLongPiece : Fields -> Result Errors Parameters.LongPiece parseLongPiece fields = case ( parseBuckleHole fields, parseField LongPieceLength (parseLength constraints.longPiece.length) fields ) of ( Ok buckleHole, Ok length ) -> let base = Parameters.default.longPiece in Ok { base | buckleHole = buckleHole, length = length } ( buckleHole, length ) -> Err (Dict.union (getError buckleHole |> Maybe.withDefault Dict.empty) (mkErrors [ ( LongPieceLength, getError length ) ]) ) parseCanvas : Fields -> Result Errors Parameters.Rendering parseCanvas fields = case ( parseField CanvasMargin (parseLength constraints.rendering.margin) fields , parseField LineWidth (parseLength constraints.rendering.lineWidth) fields , parseField ColorSchema parseColorSchema fields ) of ( Ok margin, Ok lineWidth, Ok colorSchema ) -> let base = Parameters.default.rendering in Ok { base | margin = margin, lineWidth = lineWidth, colorSchema = colorSchema } ( margin, lineWidth, colorSchema ) -> Err (mkErrors [ ( CanvasMargin, getError margin ) , ( LineWidth, getError lineWidth ) , ( ColorSchema, getError colorSchema ) ] ) parse : Fields -> Result Errors Parameters parse fields = case ( ( parseField LugWidth (parseLength constraints.lugWidth) fields , parseField LiningThickness (parseLength constraints.lining) fields , parseField SurfaceThickness (parseLength constraints.thickness) fields ) , ( parseLongPiece fields , parseShortPiece fields ) , parseCanvas fields ) of ( ( Ok lugWidth, Ok lining, Ok thickness ), ( Ok longPiece, Ok shortPiece ), Ok rendering ) -> let base = Parameters.default in Ok { base | lugWidth = lugWidth , lining = lining , thickness = thickness , longPiece = longPiece , shortPiece = shortPiece , rendering = rendering } ( ( lugWidth, lining, thickness ), ( longPiece, shortPiece ), rendering ) -> [ mkErrors [ ( LugWidth, getError lugWidth ) ] , mkErrors [ ( LiningThickness, getError lining ) ] , mkErrors [ ( SurfaceThickness, getError thickness ) ] , getError longPiece |> Maybe.withDefault Dict.empty , getError shortPiece |> Maybe.withDefault Dict.empty , getError rendering |> Maybe.withDefault Dict.empty ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of
-
@@ -597,7 +258,7 @@ , node "x-number-input"[] [ input (id (Key.toString key) :: value (model.fields |> Dict.get (Key.toString key) |> Maybe.withDefault "") :: value (model.fields |> getKey key |> Maybe.withDefault "") :: onInput (FieldChanged key) :: onFocus (Highlight key) :: onBlur (Unhighlight key)
-
@@ -659,7 +320,7 @@ choiceDescriptionId =id ++ "__description" checked = Dict.get (Key.toString key) model.fields getKey key model.fields |> Maybe.withDefault "" |> (==) choice.value in
-
@@ -705,7 +366,7 @@ boolField : Model -> BoolFieldProps Msg -> Html.Html MsgboolField model { key, title, disabled, description, attrs, true, false } = let isTrue = not (Dict.get (Key.toString key) model.fields == Nothing) hasKey key model.fields id : Bool -> String id v =
-
@@ -923,7 +584,7 @@ , title = [ text "Buckle Tongue Width" ], description = [ text "Width of the buckle tongue / pin." ] , unit = Just "mm" , disabled = not (hasField HasBuckleTongue model.fields) , disabled = not (hasKey HasBuckleTongue model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.buckle.tongue.width }
-
@@ -933,7 +594,7 @@ , title = [ text "Buckle Tongue Thickness" ], description = [ text "Thickness of the buckle tongue / pin, to add to the cutout depth." ] , unit = Just "mm" , disabled = not (hasField HasBuckleTongue model.fields) , disabled = not (hasKey HasBuckleTongue model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.buckle.tongue.thickness }
-
@@ -946,8 +607,8 @@ { key = LoopStyle, title = [ text "Loop Style" ] , description = [ text "Style of the fixed loop and the free loop." ] , disabled = not (hasField HasFixedLoop model.fields) && not (hasField HasFreeLoop model.fields) not (hasKey HasFixedLoop model.fields) && not (hasKey HasFreeLoop model.fields) , attrs = [] , choices = [ { label = [ text "Simple" ]
-
@@ -966,8 +627,8 @@ , title = [ text "Loop Leather Thickness" ], description = [ text "Thickness of the leather to use for loops. Final thickness will be doubled if you choose \"Folded\" style." ] , unit = Just "mm" , disabled = not (hasField HasFixedLoop model.fields) && not (hasField HasFreeLoop model.fields) not (hasKey HasFixedLoop model.fields) && not (hasKey HasFreeLoop model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.thickness }
-
@@ -991,7 +652,7 @@ { key = FixedLoopWidth, title = [ text "Fixed Loop Width" ] , description = [ text "Width of the fixed loop." ] , unit = Just "mm" , disabled = not (hasField HasFixedLoop model.fields) , disabled = not (hasKey HasFixedLoop model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.fixed.width }
-
@@ -1000,7 +661,7 @@ { key = FixedLoopPlay, title = [ text "Fixed Loop Play" ] , description = [ text "Extra length to add to the fixed loop, for adjusting tightness." ] , unit = Just "mm" , disabled = not (hasField HasFixedLoop model.fields) , disabled = not (hasKey HasFixedLoop model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.fixed.play }
-
@@ -1024,7 +685,7 @@ { key = FreeLoopWidth, title = [ text "Free Loop Width" ] , description = [ text "Width of the free loop." ] , unit = Just "mm" , disabled = not (hasField HasFreeLoop model.fields) , disabled = not (hasKey HasFreeLoop model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.free.width }
-
@@ -1033,7 +694,7 @@ { key = FreeLoopPlay, title = [ text "Free Loop Play" ] , description = [ text "Extra length to add to the free loop, for adjusting tightness." ] , unit = Just "mm" , disabled = not (hasField HasFreeLoop model.fields) , disabled = not (hasKey HasFreeLoop model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.free.play }
-
@@ -1042,7 +703,7 @@ { key = FreeLoopOverlap, title = [ text "Free Loop Overlap" ] , description = [ text "Length of overlapping section of the free loop for gluing and/or stitching." ] , unit = Just "mm" , disabled = not (hasField HasFreeLoop model.fields) , disabled = not (hasKey HasFreeLoop model.fields) , attrs = step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.free.overlap }
-
-
-
@@ -7,11 +7,13 @@ ---- SPDX-License-Identifier: MPL-2.0 module Parameters.Parser exposing (Error(..), parseBool, parseColorSchema, parseInt, parseLength, parseLoopStyle) module Parameters.Parser exposing (Error(..), Errors, parse) import Dict exposing (Dict) import Length exposing (Length, mm, toMM) import Parameters exposing (ColorSchema(..), LoopStyle(..)) import Parameters.Constraints as Constraints import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, getKey, hasKey) import Parameters.Constraints as Constraints exposing (constraints) import Parameters.Key as Key exposing (Key(..)) type Error
-
@@ -22,6 +24,27 @@ | NotALength| NotAnInt | NonexistentVariant String | NotABool type alias Errors = Dict String Error mkErrors : List ( Key, Maybe Error ) -> Errors mkErrors list = list |> List.filterMap (\( key, error ) -> Maybe.map (\e -> ( Key.toString key, e )) error) |> Dict.fromList getError : Result a b -> Maybe a getError r = case r of Err e -> Just e _ -> Nothing parseInt : Constraints.NumberConstraints Int -> String -> Result Error Int
-
@@ -115,19 +138,6 @@ |> min|> max parseBool : String -> Result Error Bool parseBool text = case text of "true" -> Ok True "false" -> Ok False _ -> Err NotABool parseColorSchema : String -> Result Error ColorSchema parseColorSchema text = case text of
-
@@ -152,3 +162,264 @@ Ok Folded_ -> Err (NonexistentVariant text) parseField : Key -> (String -> Result Error a) -> ParametersDict -> Result Error a parseField key f fields = getKey key fields |> Maybe.withDefault "" |> f parseFixedLoop : ParametersDict -> Result Errors (Maybe Parameters.FixedLoop) parseFixedLoop fields = if hasKey HasFixedLoop fields then case ( parseField FixedLoopWidth (parseLength constraints.shortPiece.loops.fixed.width) fields , parseField FixedLoopPlay (parseLength constraints.shortPiece.loops.fixed.play) fields ) of ( Ok width, Ok play ) -> let base = Parameters.defaultFixedLoop in Ok (Just { base | width = width, play = play }) ( width, play ) -> Err (mkErrors [ ( FixedLoopWidth, getError width ) , ( FixedLoopPlay, getError play ) ] ) else Ok Nothing parseFreeLoop : ParametersDict -> Result Errors (Maybe Parameters.FreeLoop) parseFreeLoop fields = if hasKey HasFreeLoop fields then case ( parseField FreeLoopWidth (parseLength constraints.shortPiece.loops.free.width) fields , parseField FreeLoopPlay (parseLength constraints.shortPiece.loops.free.play) fields , parseField FreeLoopOverlap (parseLength constraints.shortPiece.loops.free.overlap) fields ) of ( Ok width, Ok play, Ok overlap ) -> Ok (Just { width = width, play = play, overlap = overlap }) ( width, play, overlap ) -> Err (mkErrors [ ( FreeLoopWidth, getError width ) , ( FreeLoopPlay, getError play ) , ( FreeLoopOverlap, getError overlap ) ] ) else Ok Nothing parseLoops : ParametersDict -> Result Errors Parameters.Loops parseLoops fields = case ( ( parseFixedLoop fields, parseFreeLoop fields ) , ( parseField LoopStyle parseLoopStyle fields , parseField LoopThickness (parseLength constraints.shortPiece.loops.thickness) fields ) ) of ( ( Ok fixed, Ok free ), ( Ok style, Ok thickness ) ) -> Ok { fixed = fixed, free = free, style = style, thickness = thickness } ( ( fixed, free ), ( style, thickness ) ) -> [ getError fixed |> Maybe.withDefault Dict.empty , getError free |> Maybe.withDefault Dict.empty , mkErrors [ ( LoopStyle, getError style ), ( LoopThickness, getError thickness ) ] ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err parseBuckleTongue : ParametersDict -> Result Errors (Maybe Parameters.BuckleTongue) parseBuckleTongue fields = if hasKey HasBuckleTongue fields then case ( parseField BuckleTongueWidth (parseLength constraints.shortPiece.buckle.tongue.width) fields , parseField BuckleTongueThickness (parseLength constraints.shortPiece.buckle.tongue.thickness) fields ) of ( Ok width, Ok thickness ) -> Ok (Just { width = width, thickness = thickness }) ( width, thickness ) -> Err (mkErrors [ ( BuckleTongueWidth, getError width ) , ( BuckleTongueThickness, getError thickness ) ] ) else Ok Nothing parseBuckle : ParametersDict -> Result Errors Parameters.Buckle parseBuckle fields = case ( parseBuckleTongue fields , parseField BuckleSpringBarDiameter (parseLength constraints.shortPiece.buckle.springBarDiameter) fields ) of ( Ok tongue, Ok springBarDiameter ) -> Ok { tongue = tongue, springBarDiameter = springBarDiameter } ( tongue, springBarDiameter ) -> [ getError tongue |> Maybe.withDefault Dict.empty , mkErrors [ ( BuckleSpringBarDiameter, getError springBarDiameter ) ] ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err parseShortPiece : ParametersDict -> Result Errors Parameters.ShortPiece parseShortPiece fields = case ( parseLoops fields , parseField ShortPieceLength (parseLength constraints.shortPiece.length) fields , parseBuckle fields ) of ( Ok loops, Ok length, Ok buckle ) -> let base = Parameters.default.shortPiece in Ok { base | loops = loops, length = length, buckle = buckle } ( loops, length, buckle ) -> [ getError loops |> Maybe.withDefault Dict.empty , mkErrors [ ( ShortPieceLength, getError length ) ] , getError buckle |> Maybe.withDefault Dict.empty ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err parseBuckleHole : ParametersDict -> Result Errors Parameters.BuckleHole parseBuckleHole fields = case ( ( parseField BuckleHoleCount (parseInt constraints.longPiece.buckleHole.count) fields , parseField BuckleHoleDiameter (parseLength constraints.longPiece.buckleHole.diameter) fields ) , ( parseField BuckleHoleOffset (parseLength constraints.longPiece.buckleHole.offset) fields , parseField BuckleHoleInterval (parseLength constraints.longPiece.buckleHole.interval) fields ) ) of ( ( Ok count, Ok diameter ), ( Ok offset, Ok interval ) ) -> Ok { count = count, diameter = diameter, offset = offset, interval = interval } ( ( count, diameter ), ( offset, interval ) ) -> Err (mkErrors [ ( BuckleHoleCount, getError count ) , ( BuckleHoleDiameter, getError diameter ) , ( BuckleHoleOffset, getError offset ) , ( BuckleHoleInterval, getError interval ) ] ) parseLongPiece : ParametersDict -> Result Errors Parameters.LongPiece parseLongPiece fields = case ( parseBuckleHole fields, parseField LongPieceLength (parseLength constraints.longPiece.length) fields ) of ( Ok buckleHole, Ok length ) -> let base = Parameters.default.longPiece in Ok { base | buckleHole = buckleHole, length = length } ( buckleHole, length ) -> Err (Dict.union (getError buckleHole |> Maybe.withDefault Dict.empty) (mkErrors [ ( LongPieceLength, getError length ) ]) ) parseCanvas : ParametersDict -> Result Errors Parameters.Rendering parseCanvas fields = case ( parseField CanvasMargin (parseLength constraints.rendering.margin) fields , parseField LineWidth (parseLength constraints.rendering.lineWidth) fields , parseField ColorSchema parseColorSchema fields ) of ( Ok margin, Ok lineWidth, Ok colorSchema ) -> let base = Parameters.default.rendering in Ok { base | margin = margin, lineWidth = lineWidth, colorSchema = colorSchema } ( margin, lineWidth, colorSchema ) -> Err (mkErrors [ ( CanvasMargin, getError margin ) , ( LineWidth, getError lineWidth ) , ( ColorSchema, getError colorSchema ) ] ) parse : ParametersDict -> Result Errors Parameters parse fields = case ( ( parseField LugWidth (parseLength constraints.lugWidth) fields , parseField LiningThickness (parseLength constraints.lining) fields , parseField SurfaceThickness (parseLength constraints.thickness) fields ) , ( parseLongPiece fields , parseShortPiece fields ) , parseCanvas fields ) of ( ( Ok lugWidth, Ok lining, Ok thickness ), ( Ok longPiece, Ok shortPiece ), Ok rendering ) -> let base = Parameters.default in Ok { base | lugWidth = lugWidth , lining = lining , thickness = thickness , longPiece = longPiece , shortPiece = shortPiece , rendering = rendering } ( ( lugWidth, lining, thickness ), ( longPiece, shortPiece ), rendering ) -> [ mkErrors [ ( LugWidth, getError lugWidth ) ] , mkErrors [ ( LiningThickness, getError lining ) ] , mkErrors [ ( SurfaceThickness, getError thickness ) ] , getError longPiece |> Maybe.withDefault Dict.empty , getError shortPiece |> Maybe.withDefault Dict.empty , getError rendering |> Maybe.withDefault Dict.empty ] |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err
-