From 6bd5f8ccbd8c44c3311ef36b0e2de9ede4fa71ed Mon Sep 17 00:00:00 2001 From: Jakub Hampl Date: Thu, 14 Feb 2019 15:23:49 +0000 Subject: New Style Generator (#8) --- style-generator/src/Decoder/Expression.elm | 345 +++++++++++++++++++++++++++++ style-generator/src/Decoder/Generic.elm | 52 +++++ style-generator/src/Decoder/Helpers.elm | 9 + style-generator/src/Decoder/Legacy.elm | 110 +++++++++ 4 files changed, 516 insertions(+) create mode 100644 style-generator/src/Decoder/Expression.elm create mode 100644 style-generator/src/Decoder/Generic.elm create mode 100644 style-generator/src/Decoder/Helpers.elm create mode 100644 style-generator/src/Decoder/Legacy.elm (limited to 'style-generator/src/Decoder') diff --git a/style-generator/src/Decoder/Expression.elm b/style-generator/src/Decoder/Expression.elm new file mode 100644 index 0000000..137ab26 --- /dev/null +++ b/style-generator/src/Decoder/Expression.elm @@ -0,0 +1,345 @@ +module Decoder.Expression exposing (decodeBool, expression) + +import Color +import Decoder.Generic as Decode +import Decoder.Helpers exposing (todo) +import Json.Decode as D exposing (Decoder) +import Lib +import MyElm.Syntax exposing (Expression, call1, calln, float, int, list, pair, string) +import String.Case exposing (toCamelCaseLower) + + +expression = + D.oneOf + [ D.string |> D.map makeConstant + , decodeBool + , D.float |> D.map (float >> Lib.float) + , D.int |> D.map (int >> Lib.int) + , D.index 0 D.string |> D.andThen decodeExpression + , D.index 0 D.int |> D.andThen (always (D.map (List.map int >> list >> Lib.floats) (D.list D.int))) + , D.index 0 D.float |> D.andThen (always (D.map (List.map float >> list >> Lib.floats) (D.list D.float))) + , todo + ] + + +decodeLiteral = + D.oneOf + [ D.string |> D.map makeConstant + , decodeBool + , D.float |> D.map (float >> Lib.float) + , D.int |> D.map (int >> Lib.int) + , todo + ] + + +makeConstant s = + case s of + "map" -> + Lib.eValue "anchorMap" + + "viewport" -> + Lib.eValue "anchorViewport" + + "auto" -> + Lib.eValue "anchorAuto" + + "center" -> + Lib.eValue "positionCenter" + + "left" -> + Lib.eValue "positionLeft" + + "right" -> + Lib.eValue "positionRight" + + "top" -> + Lib.eValue "positionTop" + + "bottom" -> + Lib.eValue "positionBottom" + + "topRight" -> + Lib.eValue "positionTopRight" + + "topLeft" -> + Lib.eValue "positionTopLeft" + + "bottomLeft" -> + Lib.eValue "positionBottomLeft" + + "bottomRight" -> + Lib.eValue "positionBottomRight" + + "none" -> + Lib.eValue "textFitNone" + + "width" -> + Lib.eValue "textFitWidth" + + "height" -> + Lib.eValue "textFitHeight" + + "both" -> + Lib.eValue "textFitBoth" + + "butt" -> + Lib.eValue "lineCapButt" + + "round" -> + Lib.eValue "lineCapRound" + + "square" -> + Lib.eValue "lineCapSquare" + + "bevel" -> + Lib.eValue "lineJoinBevel" + + "miter" -> + Lib.eValue "lineJoinMiter" + + "point" -> + Lib.eValue "symbolPlacementPoint" + + "line-center" -> + Lib.eValue "symbolPlacementLineCenter" + + "line" -> + Lib.eValue "symbolPlacementLine" + + "uppercase" -> + Lib.eValue "textTransformUppercase" + + "lowercase" -> + Lib.eValue "textTransformLowercase" + + "linear" -> + Lib.eValue "rasterResamplingLinear" + + "nearest" -> + Lib.eValue "rasterResamplingNearest" + + _ -> + case Color.parse s of + Ok { r, g, b, a } -> + calln (Lib.eName "rgba") [ int r, int g, int b, float a ] + + Err err -> + string s |> Lib.str + + +decodeExpression funName = + case funName of + "literal" -> + D.index 1 + (D.oneOf + [ D.list D.string |> D.map (\strs -> calln (Lib.eName "strings") [ list (List.map string strs) ]) + , D.list D.float |> D.map (\floats -> calln (Lib.eName "floats") [ list (List.map float floats) ]) + ] + ) + + "match" -> + D.oneOf + [ D.index 2 D.string |> D.andThen (decodeMatch True) + , D.index 2 D.float |> D.andThen (decodeMatch False) + , D.index 2 (D.list D.string) |> D.andThen (decodeMatch True) + , D.index 2 (D.list D.float) |> D.andThen (decodeMatch False) + ] + + "exponential" -> + D.map (\base -> calln (Lib.eName "Exponential") [ float base ]) (D.index 1 D.float) + + "interpolate" -> + D.map3 + (\interpolation options input -> + Lib.pipelineCall "interpolate" (input :: interpolation :: options) + ) + (D.index 1 expression) + (Decode.tail D.value |> D.map (List.drop 2) |> D.andThen (organizeArgs (D.map float D.float) [])) + (D.index 2 expression) + + "step" -> + D.map3 + (\inp def stps -> + Lib.pipelineCall "step" (inp :: def :: stps) + ) + (D.index 1 expression) + (D.index 2 expression) + (Decode.tail D.value |> D.map (List.drop 2) |> D.andThen (organizeArgs (D.map float D.float) [])) + + "case" -> + D.map (calln (Lib.eName "conditionally")) + (Decode.tail D.value |> D.andThen (organizeArgs expression [])) + + _ -> + let + fallback = + Decode.tail expression + |> D.map + (\arguments -> + case funName of + "==" -> + Lib.pipelineCall "isEqual" arguments + + "!=" -> + Lib.pipelineCall "notEqual" arguments + + "!has" -> + Lib.todo "!has is not supported" + + "!in" -> + Lib.todo "!in is not supported" + + "in" -> + Lib.todo "in is not supported" + + ">=" -> + Lib.pipelineCall "greaterThanOrEqual" arguments + + ">" -> + Lib.pipelineCall "greaterThan" arguments + + "<=" -> + Lib.pipelineCall "lessThanOrEqual" arguments + + "<" -> + Lib.pipelineCall "lessThan" arguments + + "concat" -> + Lib.pipelineMultiCall "append" arguments + + "linear" -> + calln (Lib.eName "Linear") arguments + + "rgb" -> + calln (Lib.eName "makeRGBColor") arguments + + "rgba" -> + calln (Lib.eName "makeRGBAColor") arguments + + "to-rgba" -> + calln (Lib.eName "rgbaChannels") arguments + + "-" -> + Lib.pipelineMultiCall "minus" arguments + + "*" -> + Lib.pipelineMultiCall "multiply" arguments + + "+" -> + Lib.pipelineMultiCall "plus" arguments + + "/" -> + Lib.pipelineMultiCall "divideBy" arguments + + "%" -> + Lib.pipelineMultiCall "modBy" arguments + + "^" -> + Lib.pipelineMultiCall "raiseBy" arguments + + "get" -> + if List.length arguments == 1 then + calln (Lib.eName "getProperty") arguments + + else + calln (Lib.eName "get") arguments + + "all" -> + call1 (Lib.eName "all") (MyElm.Syntax.list arguments) + + "any" -> + call1 (Lib.eName "any") (MyElm.Syntax.list arguments) + + _ -> + calln (Lib.eName (toCamelCaseLower funName)) arguments + ) + in + if String.toLower funName /= funName then + D.oneOf + [ D.map (\strs -> calln (Lib.eName "strings") [ list (List.map string strs) ]) <| D.list D.string + , fallback + ] + + else + fallback + + +decodeBool = + D.bool + |> D.map + (\b -> + if b then + Lib.true + + else + Lib.false + ) + + +decodeMatch : Bool -> any -> Decoder Expression +decodeMatch isString _ = + Decode.tail D.value + |> D.andThen + (\args -> + case args of + [] -> + todo + + head :: tail -> + D.map2 + (\cond rest -> + Lib.pipelineCall + (if isString then + "matchesStr" + + else + "matchesFloat" + ) + (cond :: rest) + ) + (Decode.subdecode expression head) + (organizeArgs + (if isString then + D.map string D.string + + else + D.map float D.float + ) + [] + (normalizeArgs tail) + ) + ) + + +normalizeArgs args = + case args of + a :: b :: rest -> + case D.decodeValue (D.list D.value) a of + Err _ -> + a :: b :: rest + + Ok xs -> + List.concatMap (\x -> [ x, b ]) xs ++ normalizeArgs rest + + _ -> + args + + +organizeArgs inpDec accu args = + case args of + [] -> + Decode.combine [ D.map list (List.reverse accu |> Decode.combine) ] + + [ default ] -> + Decode.combine [ D.map list (List.reverse accu |> Decode.combine), Decode.subdecode expression default ] + + a :: b :: rest -> + let + newAccu = + D.map2 + pair + (Decode.subdecode inpDec a) + (Decode.subdecode expression b) + :: accu + in + organizeArgs inpDec newAccu rest diff --git a/style-generator/src/Decoder/Generic.elm b/style-generator/src/Decoder/Generic.elm new file mode 100644 index 0000000..b81167e --- /dev/null +++ b/style-generator/src/Decoder/Generic.elm @@ -0,0 +1,52 @@ +module Decoder.Generic exposing (combine, pair, resultToDecoder, subdecode, tail, withDefault) + +import Json.Decode as D exposing (Decoder) + + +withDefault : a -> Decoder a -> Decoder a +withDefault fallback decoder = + D.oneOf + [ decoder + , D.succeed fallback + ] + + +combine : List (Decoder a) -> Decoder (List a) +combine = + List.foldr (D.map2 (::)) (D.succeed []) + + +subdecode : Decoder a -> D.Value -> Decoder a +subdecode d v = + D.decodeValue d v |> resultToDecoder + + +tail : Decoder a -> Decoder (List a) +tail itemDecoder = + D.list D.value + |> D.andThen + (\l -> + case l of + [] -> + D.fail "Can't get tail of empty" + + head :: t -> + List.map (subdecode itemDecoder) t |> combine + ) + + +pair : Decoder a -> Decoder b -> Decoder ( a, b ) +pair aDecoder bDecoder = + D.map2 Tuple.pair + (D.index 0 aDecoder) + (D.index 1 bDecoder) + + +resultToDecoder : Result D.Error a -> Decoder a +resultToDecoder res = + case res of + Ok a -> + D.succeed a + + Err e -> + D.fail (D.errorToString e) diff --git a/style-generator/src/Decoder/Helpers.elm b/style-generator/src/Decoder/Helpers.elm new file mode 100644 index 0000000..74c47b0 --- /dev/null +++ b/style-generator/src/Decoder/Helpers.elm @@ -0,0 +1,9 @@ +module Decoder.Helpers exposing (todo) + +import Json.Decode as D exposing (Decoder) +import Json.Encode +import Lib + + +todo = + D.map (\val -> Lib.todo ("The expression " ++ Json.Encode.encode 0 val ++ " is not yet supported")) D.value diff --git a/style-generator/src/Decoder/Legacy.elm b/style-generator/src/Decoder/Legacy.elm new file mode 100644 index 0000000..2c7be93 --- /dev/null +++ b/style-generator/src/Decoder/Legacy.elm @@ -0,0 +1,110 @@ +module Decoder.Legacy exposing (filter) + +import Decoder.Expression exposing (decodeBool) +import Decoder.Generic as Decode +import Decoder.Helpers exposing (todo) +import Json.Decode as D exposing (Decoder) +import Lib +import MyElm.Syntax exposing (Expression, calln, float, int, list, pair, string) + + +filter = + let + decodeProp = + D.index 1 D.string + |> D.map + (\prop -> + case prop of + "$type" -> + Lib.eValue "geometryType" + + "$id" -> + Lib.eValue "id" + + _ -> + calln (Lib.eName "getProperty") [ Lib.str (string prop) ] + ) + + decodeVal = + D.index 2 <| + D.oneOf + [ D.map (string >> Lib.str) D.string + , D.map (float >> Lib.float) D.float + , decodeBool + ] + + decodeVals = + D.list <| + D.oneOf + [ D.map (string >> Lib.str) D.string + , D.map (float >> Lib.float) D.float + , decodeBool + ] + + operator name = + D.map2 (\prop val -> Lib.pipelineCall name [ prop, val ]) decodeProp decodeVal + in + D.index 0 D.string + |> D.andThen + (\filt -> + case filt of + "all" -> + Decode.tail filter |> D.map (\filters -> calln (Lib.eName "all") [ list filters ]) + + "any" -> + Decode.tail filter |> D.map (\filters -> calln (Lib.eName "any") [ list filters ]) + + "none" -> + Decode.tail filter |> D.map (\filters -> calln (Lib.eName "all") [ list (List.map (\f -> calln (Lib.eName "not") [ f ]) filters) ]) + + "has" -> + D.index 1 D.string |> D.map (\prop -> calln (Lib.eName "hasProperty") [ Lib.str (string prop) ]) + + "!has" -> + D.index 1 D.string |> D.map (\prop -> calln (Lib.eName "not") [ calln (Lib.eName "hasProperty") [ Lib.str (string prop) ] ]) + + "==" -> + operator "isEqual" + + "!=" -> + operator "notEqual" + + ">" -> + operator "greaterThan" + + ">=" -> + operator "greaterThanOrEqual" + + "<" -> + operator "lessThan" + + "<=" -> + operator "lessThanOrEqual" + + "in" -> + D.map2 + (\prop values -> + List.drop 2 values + |> List.map (\v -> Lib.pipelineCall "isEqual" [ prop, v ]) + |> list + |> List.singleton + |> calln (Lib.eName "any") + ) + decodeProp + decodeVals + + "!in" -> + D.map2 + (\prop values -> + List.drop 2 values + |> List.map (\v -> Lib.pipelineCall "notEqual" [ prop, v ]) + |> list + |> List.singleton + |> calln (Lib.eName "all") + ) + decodeProp + decodeVals + + _ -> + D.fail "not actually a legacy filter" + ) -- cgit v1.2.3