New Style Generator (#8)

4 files changed, 516 insertions, 0 deletions

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"
+            )