module Elm.Encoder
    ( encoder
    ) where

import           Elm.Types
import           Elm.Helpers

elmEncoder :: Expr -> String
elmEncoder (Primitive t) = case t of
    Bool ->
        "Json.Encode.bool"
    String ->
        "Json.Encode.string"
    Float ->
        "Json.Encode.float"
    Int ->
        "Json.Encode.int"
    Date ->
        "Json.Encode.string <| Date.Format.formatISO8601"
    p -> error $ "No encoder for Primitive known: " ++ show p
elmEncoder (Field f) = elmEncoder f
elmEncoder (DataType name _) = "encode" ++ name
elmEncoder (Product (Primitive List) (Primitive Char)) = elmEncoder $ Primitive String
elmEncoder (Product (Primitive List) t) =
    concat $ surround "(" " << " ")"
        [ "Json.Encode.list"
        , "List.map " ++ elmEncoder t
        ]
elmEncoder (Product (Primitive Maybe) t) =
    concat $ surround "(" " << " ")"
        [ "Maybe.withDefault Json.Encode.null"
        , "Maybe.map " ++ elmEncoder t
        ]
elmEncoder d = error $ "No encoder for definition known: " ++ show d

encoder :: Expr -> String
encoder (DataType name (Record _ expr)) = format
    [ func ++ " : " ++ name ++ " -> Json.Encode.Value"
    , func ++ " o ="
    , tab 4 "Json.Encode.object"
    , format $ map (tab 8) $ surround "[ " ", " "]" $ build expr
    ]
    where func = "encode" ++ name
          build (Product s1 s2) = build s1 ++ build s2
          build (Selector recordSel jsonSel t) =
              [ concat $ surround "(" ", " ")"
                  [ show jsonSel
                  , (elmEncoder t) ++ " o." ++ recordSel
                  ]
              ]
          build d = error $ "Unsupported Record encoder Selector definition: " ++ show d
encoder (DataType name s) = format
    [ func ++ " : " ++  name ++ " -> Json.Encode.Value"
    , func ++ " o ="
    , tab 4 "let"
    , tab 8 "resolver c = case c of"
    , format $ map (tab 12 . toCase) $ flatten s
    , tab 4 "in"
    , tab 8 $ elmEncoder (Primitive String) ++ " (resolver o)"
    ]
    where func = "encode" ++ name
          flatten (Sum a b) = flatten a ++ flatten b
          flatten (Constructor constructor _) = [constructor]
          flatten d = error $ "Unsupported Sum encoder Constructor definition: " ++ show d
          toCase constructor = constructor ++ " -> \"" ++ constructor ++ "\""
encoder d = error $ "Unsupported encoder definition: " ++ show d