diff options
Diffstat (limited to 'style-generator')
| -rw-r--r-- | style-generator/elm.json | 33 | ||||
| -rw-r--r-- | style-generator/src/Color.elm | 376 | ||||
| -rw-r--r-- | style-generator/src/Decoder.elm | 776 | ||||
| -rw-r--r-- | style-generator/src/Main.elm | 138 | ||||
| -rw-r--r-- | style-generator/src/Writer.elm | 640 |
5 files changed, 1963 insertions, 0 deletions
diff --git a/style-generator/elm.json b/style-generator/elm.json new file mode 100644 index 0000000..4f116f6 --- /dev/null +++ b/style-generator/elm.json @@ -0,0 +1,33 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.0", + "dependencies": { + "direct": { + "elm/browser": "1.0.0", + "elm/core": "1.0.0", + "elm/html": "1.0.0", + "elm/http": "1.0.0", + "elm/json": "1.0.0", + "elm/parser": "1.1.0", + "elm-community/list-extra": "8.0.0", + "stil4m/elm-syntax": "6.1.0", + "stil4m/structured-writer": "1.0.2", + "the-sett/elm-string-case": "1.0.2" + }, + "indirect": { + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.0", + "elm-community/json-extra": "4.0.0", + "rtfeldman/elm-hex": "1.0.0", + "rtfeldman/elm-iso8601-date-strings": "1.1.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +}
\ No newline at end of file diff --git a/style-generator/src/Color.elm b/style-generator/src/Color.elm new file mode 100644 index 0000000..b4e8b73 --- /dev/null +++ b/style-generator/src/Color.elm @@ -0,0 +1,376 @@ +module Color exposing (parse) + +import Bitwise exposing (shiftLeftBy) +import Parser exposing ((|.), (|=), Parser, backtrackable, end, keyword, oneOf, spaces, succeed, symbol) + + +type alias Color = + { r : Int, g : Int, b : Int, a : Float } + + +parser : Parser Color +parser = + oneOf + [ keywords + , hsla + + -- , rgba + -- , hex + ] + |. end + + +fromHSLA hue sat light alpha = + let + ( h, s, l ) = + ( toFloat hue / 360, toFloat sat / 100, toFloat light / 100 ) + + m2 = + if l <= 0.5 then + l * (s + 1) + else + l + s - l * s + + m1 = + l * 2 - m2 + + r = + hueToRgb (h + 1 / 3) + + g = + hueToRgb h + + b = + hueToRgb (h - 1 / 3) + + hueToRgb h__ = + let + h_ = + if h__ < 0 then + h__ + 1 + else if h__ > 1 then + h__ - 1 + else + h__ + in + if h_ * 6 < 1 then + m1 + (m2 - m1) * h_ * 6 + else if h_ * 2 < 1 then + m2 + else if h_ * 3 < 2 then + m1 + (m2 - m1) * (2 / 3 - h_) * 6 + else + m1 + in + Color (r * 255 |> floor) (g * 255 |> floor) (b * 255 |> floor) alpha + + +hsla : Parser Color +hsla = + succeed fromHSLA + |. oneOf [ keyword "hsla", keyword "hsl" ] + |. symbol "(" + |= angle + |. spaces + |. symbol "," + |. spaces + |= percentage + |. spaces + |. symbol "," + |. spaces + |= percentage + |= oneOf + [ succeed identity + |. symbol "," + |. spaces + |= Parser.float + , succeed 1 + ] + |. symbol ")" + + +angle = + Parser.map round Parser.float + + +percentage = + Parser.map round Parser.float + |. symbol "%" + + +fromHexString : String -> Parser Color +fromHexString hexString = + case String.toList hexString of + [ '#', r, g, b ] -> + fromHex8 ( r, r ) ( g, g ) ( b, b ) ( 'f', 'f' ) + + [ r, g, b ] -> + fromHex8 ( r, r ) ( g, g ) ( b, b ) ( 'f', 'f' ) + + [ '#', r, g, b, a ] -> + fromHex8 ( r, r ) ( g, g ) ( b, b ) ( a, a ) + + [ r, g, b, a ] -> + fromHex8 ( r, r ) ( g, g ) ( b, b ) ( a, a ) + + [ '#', r1, r2, g1, g2, b1, b2 ] -> + fromHex8 ( r1, r2 ) ( g1, g2 ) ( b1, b2 ) ( 'f', 'f' ) + + [ r1, r2, g1, g2, b1, b2 ] -> + fromHex8 ( r1, r2 ) ( g1, g2 ) ( b1, b2 ) ( 'f', 'f' ) + + [ '#', r1, r2, g1, g2, b1, b2, a1, a2 ] -> + fromHex8 ( r1, r2 ) ( g1, g2 ) ( b1, b2 ) ( a1, a2 ) + + [ r1, r2, g1, g2, b1, b2, a1, a2 ] -> + fromHex8 ( r1, r2 ) ( g1, g2 ) ( b1, b2 ) ( a1, a2 ) + + _ -> + Parser.problem "Invalid color" + + +maybeToParser : Maybe a -> Parser a +maybeToParser aMaybe = + case aMaybe of + Just a -> + succeed a + + Nothing -> + Parser.problem "something went wrong" + + +fromHex8 : ( Char, Char ) -> ( Char, Char ) -> ( Char, Char ) -> ( Char, Char ) -> Parser Color +fromHex8 ( r1, r2 ) ( g1, g2 ) ( b1, b2 ) ( a1, a2 ) = + Maybe.map4 + (\r g b a -> + Color + r + g + b + (toFloat a / 255) + ) + (hex2ToInt r1 r2) + (hex2ToInt g1 g2) + (hex2ToInt b1 b2) + (hex2ToInt a1 a2) + |> maybeToParser + + +hex2ToInt : Char -> Char -> Maybe Int +hex2ToInt c1 c2 = + Maybe.map2 (\v1 v2 -> shiftLeftBy 4 v1 + v2) (hexToInt c1) (hexToInt c2) + + +hexToInt : Char -> Maybe Int +hexToInt char = + case Char.toLower char of + '0' -> + Just 0 + + '1' -> + Just 1 + + '2' -> + Just 2 + + '3' -> + Just 3 + + '4' -> + Just 4 + + '5' -> + Just 5 + + '6' -> + Just 6 + + '7' -> + Just 7 + + '8' -> + Just 8 + + '9' -> + Just 9 + + 'a' -> + Just 10 + + 'b' -> + Just 11 + + 'c' -> + Just 12 + + 'd' -> + Just 13 + + 'e' -> + Just 14 + + 'f' -> + Just 15 + + _ -> + Nothing + + +keywords : Parser Color +keywords = + oneOf + [ fromHexString "#000000" |. keyword "black" + , fromHexString "#c0c0c0" |. keyword "silver" + , fromHexString "#808080" |. keyword "gray" + , fromHexString "#ffffff" |. keyword "white" + , fromHexString "#800000" |. keyword "maroon" + , fromHexString "#ff0000" |. keyword "red" + , fromHexString "#800080" |. keyword "purple" + , fromHexString "#ff00ff" |. keyword "fuchsia" + , fromHexString "#008000" |. keyword "green" + , fromHexString "#00ff00" |. keyword "lime" + , fromHexString "#808000" |. keyword "olive" + , fromHexString "#ffff00" |. keyword "yellow" + , fromHexString "#000080" |. keyword "navy" + , fromHexString "#0000ff" |. keyword "blue" + , fromHexString "#008080" |. keyword "teal" + , fromHexString "#00ffff" |. keyword "aqua" + , fromHexString "#ffa500" |. keyword "orange" + , fromHexString "#f0f8ff" |. keyword "aliceblue" + , fromHexString "#faebd7" |. keyword "antiquewhite" + , fromHexString "#7fffd4" |. keyword "aquamarine" + , fromHexString "#f0ffff" |. keyword "azure" + , fromHexString "#f5f5dc" |. keyword "beige" + , fromHexString "#ffe4c4" |. keyword "bisque" + , fromHexString "#ffebcd" |. keyword "blanchedalmond" + , fromHexString "#8a2be2" |. keyword "blueviolet" + , fromHexString "#a52a2a" |. keyword "brown" + , fromHexString "#deb887" |. keyword "burlywood" + , fromHexString "#5f9ea0" |. keyword "cadetblue" + , fromHexString "#7fff00" |. keyword "chartreuse" + , fromHexString "#d2691e" |. keyword "chocolate" + , fromHexString "#ff7f50" |. keyword "coral" + , fromHexString "#6495ed" |. keyword "cornflowerblue" + , fromHexString "#fff8dc" |. keyword "cornsilk" + , fromHexString "#dc143c" |. keyword "crimson" + , fromHexString "#00ffff" |. keyword "cyan" + , fromHexString "#00008b" |. keyword "darkblue" + , fromHexString "#008b8b" |. keyword "darkcyan" + , fromHexString "#b8860b" |. keyword "darkgoldenrod" + , fromHexString "#a9a9a9" |. keyword "darkgray" + , fromHexString "#006400" |. keyword "darkgreen" + , fromHexString "#a9a9a9" |. keyword "darkgrey" + , fromHexString "#bdb76b" |. keyword "darkkhaki" + , fromHexString "#8b008b" |. keyword "darkmagenta" + , fromHexString "#556b2f" |. keyword "darkolivegreen" + , fromHexString "#ff8c00" |. keyword "darkorange" + , fromHexString "#9932cc" |. keyword "darkorchid" + , fromHexString "#8b0000" |. keyword "darkred" + , fromHexString "#e9967a" |. keyword "darksalmon" + , fromHexString "#8fbc8f" |. keyword "darkseagreen" + , fromHexString "#483d8b" |. keyword "darkslateblue" + , fromHexString "#2f4f4f" |. keyword "darkslategray" + , fromHexString "#2f4f4f" |. keyword "darkslategrey" + , fromHexString "#00ced1" |. keyword "darkturquoise" + , fromHexString "#9400d3" |. keyword "darkviolet" + , fromHexString "#ff1493" |. keyword "deeppink" + , fromHexString "#00bfff" |. keyword "deepskyblue" + , fromHexString "#696969" |. keyword "dimgray" + , fromHexString "#696969" |. keyword "dimgrey" + , fromHexString "#1e90ff" |. keyword "dodgerblue" + , fromHexString "#b22222" |. keyword "firebrick" + , fromHexString "#fffaf0" |. keyword "floralwhite" + , fromHexString "#228b22" |. keyword "forestgreen" + , fromHexString "#dcdcdc" |. keyword "gainsboro" + , fromHexString "#f8f8ff" |. keyword "ghostwhite" + , fromHexString "#ffd700" |. keyword "gold" + , fromHexString "#daa520" |. keyword "goldenrod" + , fromHexString "#adff2f" |. keyword "greenyellow" + , fromHexString "#808080" |. keyword "grey" + , fromHexString "#f0fff0" |. keyword "honeydew" + , fromHexString "#ff69b4" |. keyword "hotpink" + , fromHexString "#cd5c5c" |. keyword "indianred" + , fromHexString "#4b0082" |. keyword "indigo" + , fromHexString "#fffff0" |. keyword "ivory" + , fromHexString "#f0e68c" |. keyword "khaki" + , fromHexString "#e6e6fa" |. keyword "lavender" + , fromHexString "#fff0f5" |. keyword "lavenderblush" + , fromHexString "#7cfc00" |. keyword "lawngreen" + , fromHexString "#fffacd" |. keyword "lemonchiffon" + , fromHexString "#add8e6" |. keyword "lightblue" + , fromHexString "#f08080" |. keyword "lightcoral" + , fromHexString "#e0ffff" |. keyword "lightcyan" + , fromHexString "#fafad2" |. keyword "lightgoldenrodyellow" + , fromHexString "#d3d3d3" |. keyword "lightgray" + , fromHexString "#90ee90" |. keyword "lightgreen" + , fromHexString "#d3d3d3" |. keyword "lightgrey" + , fromHexString "#ffb6c1" |. keyword "lightpink" + , fromHexString "#ffa07a" |. keyword "lightsalmon" + , fromHexString "#20b2aa" |. keyword "lightseagreen" + , fromHexString "#87cefa" |. keyword "lightskyblue" + , fromHexString "#778899" |. keyword "lightslategray" + , fromHexString "#778899" |. keyword "lightslategrey" + , fromHexString "#b0c4de" |. keyword "lightsteelblue" + , fromHexString "#ffffe0" |. keyword "lightyellow" + , fromHexString "#32cd32" |. keyword "limegreen" + , fromHexString "#faf0e6" |. keyword "linen" + , fromHexString "#ff00ff" |. keyword "magenta" + , fromHexString "#66cdaa" |. keyword "mediumaquamarine" + , fromHexString "#0000cd" |. keyword "mediumblue" + , fromHexString "#ba55d3" |. keyword "mediumorchid" + , fromHexString "#9370db" |. keyword "mediumpurple" + , fromHexString "#3cb371" |. keyword "mediumseagreen" + , fromHexString "#7b68ee" |. keyword "mediumslateblue" + , fromHexString "#00fa9a" |. keyword "mediumspringgreen" + , fromHexString "#48d1cc" |. keyword "mediumturquoise" + , fromHexString "#c71585" |. keyword "mediumvioletred" + , fromHexString "#191970" |. keyword "midnightblue" + , fromHexString "#f5fffa" |. keyword "mintcream" + , fromHexString "#ffe4e1" |. keyword "mistyrose" + , fromHexString "#ffe4b5" |. keyword "moccasin" + , fromHexString "#ffdead" |. keyword "navajowhite" + , fromHexString "#fdf5e6" |. keyword "oldlace" + , fromHexString "#6b8e23" |. keyword "olivedrab" + , fromHexString "#ff4500" |. keyword "orangered" + , fromHexString "#da70d6" |. keyword "orchid" + , fromHexString "#eee8aa" |. keyword "palegoldenrod" + , fromHexString "#98fb98" |. keyword "palegreen" + , fromHexString "#afeeee" |. keyword "paleturquoise" + , fromHexString "#db7093" |. keyword "palevioletred" + , fromHexString "#ffefd5" |. keyword "papayawhip" + , fromHexString "#ffdab9" |. keyword "peachpuff" + , fromHexString "#cd853f" |. keyword "peru" + , fromHexString "#ffc0cb" |. keyword "pink" + , fromHexString "#dda0dd" |. keyword "plum" + , fromHexString "#b0e0e6" |. keyword "powderblue" + , fromHexString "#bc8f8f" |. keyword "rosybrown" + , fromHexString "#4169e1" |. keyword "royalblue" + , fromHexString "#8b4513" |. keyword "saddlebrown" + , fromHexString "#fa8072" |. keyword "salmon" + , fromHexString "#f4a460" |. keyword "sandybrown" + , fromHexString "#2e8b57" |. keyword "seagreen" + , fromHexString "#fff5ee" |. keyword "seashell" + , fromHexString "#a0522d" |. keyword "sienna" + , fromHexString "#87ceeb" |. keyword "skyblue" + , fromHexString "#6a5acd" |. keyword "slateblue" + , fromHexString "#708090" |. keyword "slategray" + , fromHexString "#708090" |. keyword "slategrey" + , fromHexString "#fffafa" |. keyword "snow" + , fromHexString "#00ff7f" |. keyword "springgreen" + , fromHexString "#4682b4" |. keyword "steelblue" + , fromHexString "#d2b48c" |. keyword "tan" + , fromHexString "#d8bfd8" |. keyword "thistle" + , fromHexString "#ff6347" |. keyword "tomato" + , fromHexString "#40e0d0" |. keyword "turquoise" + , fromHexString "#ee82ee" |. keyword "violet" + , fromHexString "#f5deb3" |. keyword "wheat" + , fromHexString "#f5f5f5" |. keyword "whitesmoke" + , fromHexString "#9acd32" |. keyword "yellowgreen" + , fromHexString "#663399" |. keyword "rebeccapurple" + , succeed (Color 0 0 0 0) |. keyword "transparent" + ] + + +parse : String -> Result String Color +parse string = + Parser.run parser string |> Result.mapError Parser.deadEndsToString diff --git a/style-generator/src/Decoder.elm b/style-generator/src/Decoder.elm new file mode 100644 index 0000000..65dc0a2 --- /dev/null +++ b/style-generator/src/Decoder.elm @@ -0,0 +1,776 @@ +module Decoder exposing (styleCode) + +import Color +import Elm.Syntax.Declaration exposing (Declaration(..)) +import Elm.Syntax.Exposing exposing (Exposing(..), TopLevelExpose(..)) +import Elm.Syntax.Expression exposing (Expression(..), RecordSetter) +import Elm.Syntax.Infix exposing (InfixDirection(..)) +import Elm.Syntax.Module exposing (Module(..)) +import Elm.Syntax.Node exposing (Node(..)) +import Elm.Syntax.Pattern +import Elm.Syntax.Range exposing (emptyRange) +import Elm.Syntax.TypeAnnotation exposing (TypeAnnotation(..)) +import Json.Decode as D exposing (Decoder) +import Json.Encode +import String.Case exposing (toCamelCaseLower) +import Writer + + +node = + Node emptyRange + + +wrapNodes = + List.map node + + +styleCode : Decoder String +styleCode = + D.map (file >> Writer.writeFile >> Writer.write) style + + +declarations styleDec = + [ FunctionDeclaration + { documentation = Nothing + , signature = + Just + (node + { name = node "style" + , typeAnnotation = node (Typed (node ( [], "Style" )) []) + } + ) + , declaration = + node + { name = node "style" + , arguments = [] + , expression = + node <| + Application <| + wrapNodes + [ FunctionOrValue [] "Style" + , RecordExpr styleDec + ] + } + } + ] + + +file styleDec = + { moduleDefinition = + node + (NormalModule + { moduleName = node [ "Style" ] + , exposingList = node (Explicit [ node (FunctionExpose "style") ]) + } + ) + , imports = + [ node + { moduleName = node [ "Mapbox", "Style" ] + , moduleAlias = Just (node [ "Style" ]) + , exposingList = Just (Explicit [ node (TypeExpose { name = "Style", open = Just emptyRange }) ]) + } + , node + { moduleName = node [ "Mapbox", "Source" ] + , moduleAlias = Just (node [ "Source" ]) + , exposingList = Nothing + } + , node + { moduleName = node [ "Mapbox", "Layer" ] + , moduleAlias = Just (node [ "Layer" ]) + , exposingList = Nothing + } + , node + { moduleName = node [ "Mapbox", "Expression" ] + , moduleAlias = Just (node [ "E" ]) + , exposingList = Just (Explicit [ node (FunctionExpose "str"), node (FunctionExpose "float"), node (FunctionExpose "int"), node (FunctionExpose "true"), node (FunctionExpose "false") ]) + } + ] + , declarations = List.map node (declarations styleDec) + , comments = [] + } + + +style : Decoder (List (Node RecordSetter)) +style = + D.map5 + (\transition light layers sources misc -> + [ node ( node "transition", transition ) + , node ( node "light", light ) + , node ( node "layers", layers ) + , node ( node "sources", sources ) + , node ( node "misc", misc ) + ] + ) + (D.oneOf + [ D.field "transition" decodeTransition + , valueDecoder "Style" "defaultTransition" + ] + ) + (D.oneOf + [ D.field "light" decodeLight + , valueDecoder "Style" "defaultLight" + ] + ) + (D.field "layers" decodeLayers) + (D.field "sources" decodeSources) + decodeMisc + + +decodeTransition : Decoder (Node Expression) +decodeTransition = + D.map2 + (\duration delay -> + node + (RecordExpr + [ node ( node "duration", node (Integer duration) ) + , node ( node "delay", node (Integer delay) ) + ] + ) + ) + (D.oneOf [ D.field "duration" D.int, D.succeed 300 ]) + (D.oneOf [ D.field "delay" D.int, D.succeed 0 ]) + + +decodeLight : Decoder (Node Expression) +decodeLight = + valueDecoder "Style" "defaultLight" + + +addBogusRange index (Node _ v) = + Node { start = { row = index, column = 0 }, end = { row = index + 1, column = 0 } } v + + +decodeLayers : Decoder (Node Expression) +decodeLayers = + D.list decodeLayer + |> D.map (\layers -> node (ListExpr (List.indexedMap addBogusRange layers))) + + +layerDecodeHelp t = + D.map3 (\id source attrs -> call "Layer" t [ str id, str source, list attrs ]) (D.field "id" D.string) (D.field "source" D.string) decodeAttrs + + +decodeLayer : Decoder (Node Expression) +decodeLayer = + D.field "type" D.string + |> D.andThen + (\t -> + case t of + "background" -> + D.map2 (\id attrs -> call "Layer" "background" [ str id, list attrs ]) (D.field "id" D.string) decodeAttrs + + "fill" -> + layerDecodeHelp "fill" + + "symbol" -> + layerDecodeHelp "symbol" + + "line" -> + layerDecodeHelp "line" + + "raster" -> + layerDecodeHelp "raster" + + "circle" -> + layerDecodeHelp "circle" + + "fill-extrusion" -> + layerDecodeHelp "fillExtrusion" + + "heatmap" -> + layerDecodeHelp "heatmap" + + "hillshade" -> + layerDecodeHelp "hillshade" + + other -> + D.fail ("Layer type " ++ t ++ " not supported") + ) + + +decodeAttrs : Decoder (List (Node Expression)) +decodeAttrs = + D.map3 (\top paint layout -> top ++ paint ++ layout) (D.keyValuePairs D.value) (D.field "paint" (D.keyValuePairs D.value)) (D.field "layout" (D.keyValuePairs D.value)) + |> D.andThen + (List.filterMap + (\( attrName, attrValue ) -> + case attrName of + "id" -> + Nothing + + "type" -> + Nothing + + "source" -> + Nothing + + "paint" -> + Nothing + + "layout" -> + Nothing + + "source-layer" -> + decodeAttr "sourceLayer" (D.map str D.string) attrValue + + "minzoom" -> + decodeAttr "minzoom" (D.map float D.float) attrValue + + "maxzoom" -> + decodeAttr "maxzoom" (D.map float D.float) attrValue + + "filter" -> + decodeAttr "filter" (D.oneOf [ decodeLegacyFilter, decodeValue ]) attrValue + + other -> + decodeAttr (toCamelCaseLower attrName) decodeValue attrValue + ) + >> combine + ) + |> D.map (List.indexedMap addBogusRange) + + +decodeAttr : String -> Decoder (Node Expression) -> D.Value -> Maybe (Decoder (Node Expression)) +decodeAttr attrName expressionNodeDecoder attrValue = + Just + (D.decodeValue expressionNodeDecoder attrValue + |> resultToDecoder + |> D.map (\v -> call "Layer" (toCamelCaseLower attrName) [ v ]) + ) + + +resultToDecoder : Result D.Error a -> Decoder a +resultToDecoder res = + case res of + Ok a -> + D.succeed a + + Err e -> + D.fail (D.errorToString e) + + +decodeBool : Decoder (Node Expression) +decodeBool = + D.bool + |> D.map + (\b -> + if b then + evalue "true" + else + evalue "false" + ) + + +decodeValue : Decoder (Node Expression) +decodeValue = + D.oneOf + [ D.string |> D.map makeConstant + , decodeBool + , D.float |> D.map (Floatable >> node >> ecall "float") + , D.int |> D.map (Integer >> node >> ecall "int") + , D.index 0 D.string |> D.andThen decodeExpression + , todo + ] + |> D.map (ParenthesizedExpression >> node) + + +makeConstant s = + case s of + "map" -> + value "E" "anchorMap" + + "viewport" -> + value "E" "anchorViewport" + + "auto" -> + value "E" "anchorAuto" + + "center" -> + value "E" "positionCenter" + + "left" -> + value "E" "positionLeft" + + "right" -> + value "E" "positionRight" + + "top" -> + value "E" "positionTop" + + "bottom" -> + value "E" "positionBottom" + + "topRight" -> + value "E" "positionTopRight" + + "topLeft" -> + value "E" "positionTopLeft" + + "bottomLeft" -> + value "E" "positionBottomLeft" + + "bottomRight" -> + value "E" "positionBottomRight" + + "none" -> + value "E" "textFitNone" + + "width" -> + value "E" "textFitWidth" + + "height" -> + value "E" "textFitHeight" + + "both" -> + value "E" "textFitBoth" + + "butt" -> + value "E" "lineCapButt" + + "round" -> + value "E" "lineCapRound" + + "square" -> + value "E" "lineCapSquare" + + "bevel" -> + value "E" "lineJoinBevel" + + "miter" -> + value "E" "lineJoinMiter" + + "point" -> + value "E" "symbolPlacementPoint" + + "line-center" -> + value "E" "symbolPlacementLineCenter" + + "line" -> + value "E" "symbolPlacementLine" + + "uppercase" -> + value "E" "textTransformUppercase" + + "lowercase" -> + value "E" "textTransformLowercase" + + "linear" -> + value "E" "rasterResamplingLinear" + + "nearest" -> + value "E" "rasterResamplingNearest" + + _ -> + case Color.parse s of + Ok { r, g, b, a } -> + call "E" "rgba" [ integer r, integer g, integer b, float a ] + + Err err -> + str s |> ecall "str" + + + +-- legacy filter + + +decodeLegacyFilter : Decoder (Node Expression) +decodeLegacyFilter = + let + decodeProp = + D.index 1 D.string + |> D.map + (\prop -> + case prop of + "$type" -> + value "E" "geometryType" + + "$id" -> + value "E" "id" + + _ -> + call "E" "getProperty" [ ecall "str" (str prop) ] + ) + + decodeVal = + D.index 2 <| + D.oneOf + [ D.map (str >> ecall "str") D.string + , D.map (float >> ecall "float") D.float + , decodeBool + ] + + decodeVals = + D.list <| + D.oneOf + [ D.map (str >> ecall "str") D.string + , D.map (float >> ecall "float") D.float + , decodeBool + ] + in + D.index 0 D.string + |> D.andThen + (\filter -> + case filter of + "all" -> + decodeTail decodeLegacyFilter |> D.map (\filters -> call "E" "all" [ list filters ]) + + "any" -> + decodeTail decodeLegacyFilter |> D.map (\filters -> call "E" "any" [ list filters ]) + + "none" -> + decodeTail decodeLegacyFilter |> D.map (\filters -> call "E" "all" [ list (List.map (\f -> call "E" "not" [ f ]) filters) ]) + + "has" -> + D.index 1 D.string |> D.map (\prop -> call "E" "hasProperty" [ ecall "str" (str prop) ]) + + "!has" -> + D.index 1 D.string |> D.map (\prop -> call "E" "not" [ call "E" "hasProperty" [ ecall "str" (str prop) ] ]) + + "==" -> + D.map2 (\prop val -> pipelineCall "E" "isEqual" [ prop, val ]) decodeProp decodeVal + + "!=" -> + D.map2 (\prop val -> pipelineCall "E" "notEqual" [ prop, val ]) decodeProp decodeVal + + ">" -> + D.map2 (\prop val -> pipelineCall "E" "greaterThan" [ prop, val ]) decodeProp decodeVal + + ">=" -> + D.map2 (\prop val -> pipelineCall "E" "greaterThanOrEqual" [ prop, val ]) decodeProp decodeVal + + "<" -> + D.map2 (\prop val -> pipelineCall "E" "lessThan" [ prop, val ]) decodeProp decodeVal + + "<=" -> + D.map2 (\prop val -> pipelineCall "E" "lessThanOrEqual" [ prop, val ]) decodeProp decodeVal + + "in" -> + D.map2 + (\prop values -> + List.drop 2 values + |> List.map (\v -> pipelineCall "E" "isEqual" [ prop, v ]) + |> list + |> List.singleton + |> call "E" "any" + ) + decodeProp + decodeVals + + "!in" -> + D.map2 + (\prop values -> + List.drop 2 values + |> List.map (\v -> pipelineCall "E" "notEqual" [ prop, v ]) + |> list + |> List.singleton + |> call "E" "all" + ) + decodeProp + decodeVals + + _ -> + D.fail "not actually a legacy filter" + ) + + + +-- Expressions + + +decodeTail : Decoder a -> Decoder (List a) +decodeTail 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 + ) + + +subdecode : Decoder a -> D.Value -> Decoder a +subdecode d v = + D.decodeValue d v |> resultToDecoder + + +decodeMatch : Bool -> any -> Decoder (Node Expression) +decodeMatch isString _ = + decodeTail D.value + |> D.andThen + (\args -> + case args of + [] -> + todo + + head :: tail -> + D.map2 + (\cond rest -> + parens + (node + (OperatorApplication "|>" + Right + cond + (call "E" + (if isString then + "matchesStr" + else + "matchesFloat" + ) + rest + ) + ) + ) + ) + (subdecode decodeValue head) + (organizeArgs + (if isString then + D.map str D.string + else + D.map float D.float + ) + [] + tail + ) + ) + + +organizeArgs : Decoder (Node Expression) -> List (Decoder (Node Expression)) -> List D.Value -> Decoder (List (Node Expression)) +organizeArgs inpDec accu args = + case args of + [] -> + combine [ D.map list (List.reverse accu |> combine) ] + + [ default ] -> + combine [ D.map list (List.reverse accu |> combine), subdecode decodeValue default ] + + a :: b :: rest -> + let + newAccu = + D.map2 + (\inp out -> + parens (node (TupledExpression [ inp, out ])) + ) + (subdecode inpDec a) + (subdecode decodeValue b) + :: accu + in + organizeArgs inpDec newAccu rest + + +decodeExpression : String -> Decoder (Node Expression) +decodeExpression funName = + case funName of + "literal" -> + D.index 1 + (D.oneOf + [ D.list D.string |> D.map (\strs -> call "E" "strings" [ list (List.map str strs) ]) + , D.list D.float |> D.map (\floats -> call "E" "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) + ] + + "exponential" -> + D.map (\base -> call "E" "Exponential" [ float base ]) (D.index 1 D.float) + + "interpolate" -> + D.map3 + (\interpolation options input -> + pipelineCall "E" "interpolate" (input :: interpolation :: options) + ) + (D.index 1 decodeValue) + (decodeTail D.value |> D.map (List.drop 2) |> D.andThen (organizeArgs (D.map float D.float) [])) + (D.index 2 decodeValue) + + "step" -> + D.map3 + (\inp def stps -> + pipelineCall "E" "step" (inp :: def :: stps) + ) + (D.index 1 decodeValue) + (D.index 2 decodeValue) + (decodeTail D.value |> D.map (List.drop 2) |> D.andThen (organizeArgs (D.map float D.float) [])) + + _ -> + let + fallback = + decodeTail decodeValue + |> D.map + (\arguments -> + case funName of + "==" -> + pipelineCall "E" "isEqual" arguments + + "!=" -> + pipelineCall "E" "notEqual" arguments + + "!has" -> + todoExpr "!has is not supported" + + "!in" -> + todoExpr "!in is not supported" + + "in" -> + todoExpr "in is not supported" + + ">=" -> + pipelineCall "E" "greaterThanOrEqual" arguments + + |