module Elm.Record
    ( record
    ) where

import           Elm.Helpers
import           Elm.Types

elmType :: Expr -> String
elmType (Primitive t) = show t
elmType (DataType name _) = name
elmType (Product (Primitive List) (Primitive Char)) = elmType $ Primitive String
elmType (Product (Primitive List) t) =
    "List " ++ if isProduct t
               then "(" ++ elmType t ++ ")"
               else elmType t
elmType (Product (Primitive Maybe) t) =
    "Maybe " ++ if isProduct t
               then "(" ++ elmType t ++ ")"
               else elmType t
elmType (Field f) = elmType f
elmType d = error $ "Unsupported Type: " ++ show d

record :: Expr -> String
record (DataType name (Record _ expr)) = format
    [ "type alias " ++ name ++ " ="
    , format $ map (tab 4) $ surround "{ " ", " "}" $ build expr
    ]
    where build (Product s1 s2) = build s1 ++ build s2
          build (Selector selector _ t) = [selector ++ " : " ++ elmType t]
          build d = error $ "Unsupported Record type Selector definition: " ++ show d
record d = error $ "Unsupported type definition: " ++ show d