    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE ScopedTypeVariables       #-}
    {-|
    Functions in this module are used to generate Elm modules. Note that the generated modules depend on the @bartavelle/json-helpers@ package.

    -}
    module Elm.Module where

    import           Control.Arrow (second)
    import           Data.List
    import           Data.Proxy

    import           Elm.Json
    import           Elm.TyRender
    import           Elm.TyRep
    import           Elm.Versions

    -- | Existential quantification wrapper for lists of type definitions
    data DefineElm
       = forall a. IsElmDefinition a => DefineElm (Proxy a)

    -- | The module header line for this version of Elm
    moduleHeader :: ElmVersion
                 -> String
                 -> String
    moduleHeader :: ElmVersion -> String -> String
    moduleHeader ElmVersion
    _ String
    moduleName = String
    "module " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    moduleName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " exposing(..)"

    -- | Creates an Elm module for the given version. This will use the default
    -- type conversion rules (to -- convert @Vector@ to @List@, @HashMap a b@
    -- to @List (a,b)@, etc.).
    makeElmModuleWithVersion :: ElmVersion
                             -> String  -- ^ Module name
                             -> [DefineElm]  -- ^ List of definitions to be included in the module
                             -> String
    makeElmModuleWithVersion :: ElmVersion -> String -> [DefineElm] -> String
    makeElmModuleWithVersion ElmVersion
    elmVersion String
    moduleName [DefineElm]
    defs = [String] -> String
    unlines
        [ ElmVersion -> String -> String
    moduleHeader ElmVersion
    elmVersion String
    moduleName
        , String
    ""
        , String
    "import Json.Decode"
        , String
    "import Json.Encode exposing (Value)"
        , String
    "-- The following module comes from bartavelle/json-helpers"
        , String
    "import Json.Helpers exposing (..)"
        , String
    "import Dict exposing (Dict)"
        , String
    "import Set exposing (Set)"
        , String
    ""
        , String
    ""
        ] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [DefineElm] -> String
    makeModuleContent [DefineElm]
    defs

    -- | Creates an Elm module. This will use the default type conversion rules (to
    -- convert @Vector@ to @List@, @HashMap a b@ to @List (a,b)@, etc.).
    --
    -- default to 0.19
    makeElmModule :: String -- ^ Module name
                  -> [DefineElm] -- ^ List of definitions to be included in the module
                  -> String
    makeElmModule :: String -> [DefineElm] -> String
    makeElmModule = ElmVersion -> String -> [DefineElm] -> String
    makeElmModuleWithVersion ElmVersion
    Elm0p19

    -- | Generates the content of a module. You will be responsible for
    -- including the required Elm headers. This uses the default type
    -- conversion rules.
    makeModuleContent :: [DefineElm] -> String
    makeModuleContent :: [DefineElm] -> String
    makeModuleContent = (ETypeDef -> ETypeDef) -> [DefineElm] -> String
    makeModuleContentWithAlterations ETypeDef -> ETypeDef
    defaultAlterations

    -- | Generates the content of a module, using custom type conversion rules.
    makeModuleContentWithAlterations :: (ETypeDef -> ETypeDef) -> [DefineElm] -> String
    makeModuleContentWithAlterations :: (ETypeDef -> ETypeDef) -> [DefineElm] -> String
    makeModuleContentWithAlterations ETypeDef -> ETypeDef
    alt = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n\n" ([String] -> String)
    -> ([DefineElm] -> [String]) -> [DefineElm] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DefineElm -> String) -> [DefineElm] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map DefineElm -> String
    mkDef
        where
          mkDef :: DefineElm -> String
    mkDef (DefineElm Proxy a
    proxy) =
              let def :: ETypeDef
    def = ETypeDef -> ETypeDef
    alt (Proxy a -> ETypeDef
    forall a. IsElmDefinition a => Proxy a -> ETypeDef
    compileElmDef Proxy a
    proxy)
              in ETypeDef -> String
    forall a. ElmRenderable a => a -> String
    renderElm ETypeDef
    def String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeDef -> String
    jsonParserForDef ETypeDef
    def String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeDef -> String
    jsonSerForDef ETypeDef
    def String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"

    {-| A helper function that will recursively traverse type definitions and let you convert types.

    > myAlteration : ETypeDef -> ETypeDef
    > myAlteration = recAlterType $ \t -> case t of
    >                   ETyCon (ETCon "Integer") -> ETyCon (ETCon "Int")
    >                   ETyCon (ETCon "Text")    -> ETyCon (ETCon "String")
    >                   _                        -> t

    -}
    recAlterType :: (EType -> EType) -> ETypeDef -> ETypeDef
    recAlterType :: (EType -> EType) -> ETypeDef -> ETypeDef
    recAlterType EType -> EType
    f ETypeDef
    td = case ETypeDef
    td of
                         ETypeAlias EAlias
    a -> EAlias -> ETypeDef
    ETypeAlias (EAlias
    a { ea_fields = map (second f') (ea_fields a) })
                         ETypePrimAlias (EPrimAlias ETypeName
    n EType
    t) -> EPrimAlias -> ETypeDef
    ETypePrimAlias (ETypeName -> EType -> EPrimAlias
    EPrimAlias ETypeName
    n (EType -> EType
    f' EType
    t))
                         ETypeSum ESum
    s -> ESum -> ETypeDef
    ETypeSum (ESum
    s { es_constructors = map alterTypes (es_constructors s) })
        where
          alterTypes :: SumTypeConstructor -> SumTypeConstructor
          alterTypes :: SumTypeConstructor -> SumTypeConstructor
    alterTypes (STC String
    cn String
    dn SumTypeFields
    s) = String -> String -> SumTypeFields -> SumTypeConstructor
    STC String
    cn String
    dn (SumTypeFields -> SumTypeConstructor)
    -> SumTypeFields -> SumTypeConstructor
    forall a b. (a -> b) -> a -> b
    $ case SumTypeFields
    s of
                          Anonymous [EType]
    flds -> [EType] -> SumTypeFields
    Anonymous ((EType -> EType) -> [EType] -> [EType]
    forall a b. (a -> b) -> [a] -> [b]
    map EType -> EType
    f' [EType]
    flds)
                          Named [(String, EType)]
    flds     -> [(String, EType)] -> SumTypeFields
    Named (((String, EType) -> (String, EType))
    -> [(String, EType)] -> [(String, EType)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EType -> EType) -> (String, EType) -> (String, EType)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second EType -> EType
    f') [(String, EType)]
    flds)
          f' :: EType -> EType
    f' (ETyApp EType
    a EType
    b) = EType -> EType
    f (EType -> EType -> EType
    ETyApp (EType -> EType
    f' EType
    a) (EType -> EType
    f' EType
    b))
          f' EType
    x            = EType -> EType
    f EType
    x

    -- | Given a list of type names, will @newtype@ all the matching type
    -- definitions.
    newtypeAliases :: [String] -> ETypeDef -> ETypeDef
    newtypeAliases :: [String] -> ETypeDef -> ETypeDef
    newtypeAliases [String]
    nts (ETypeAlias EAlias
    e) = EAlias -> ETypeDef
    ETypeAlias (EAlias -> ETypeDef) -> EAlias -> ETypeDef
    forall a b. (a -> b) -> a -> b
    $ if ETypeName -> String
    et_name (EAlias -> ETypeName
    ea_name EAlias
    e) String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    nts
                                                         then EAlias
    e { ea_newtype = True }
                                                         else EAlias
    e
    newtypeAliases [String]
    _ ETypeDef
    x = ETypeDef
    x

    {-| A default set of type conversion rules:

     * @HashSet a@, @Set a@ -> if @a@ is comparable, then @Set a@, else @List a@
     * @HashMap String v@, @Map String v@ -> @Dict String v@
     * @HashMap k v@, @Map k v@ -> @List (k, v)@
     * @Integer@ -> @Int@
     * @Text@ -> @String@
     * @Vector@ -> @List@
     * @Double@ -> @Float@
     * @Tagged t v@ -> @v@
    -}
    defaultAlterations :: ETypeDef -> ETypeDef
    defaultAlterations :: ETypeDef -> ETypeDef
    defaultAlterations = (EType -> EType) -> ETypeDef -> ETypeDef
    recAlterType EType -> EType
    defaultTypeAlterations

    defaultTypeAlterations :: EType -> EType
    defaultTypeAlterations :: EType -> EType
    defaultTypeAlterations EType
    t = case EType
    t of
                                ETyApp (ETyCon (ETCon String
    "HashSet")) EType
    s             -> EType -> EType
    checkSet (EType -> EType) -> EType -> EType
    forall a b. (a -> b) -> a -> b
    $ EType -> EType
    defaultTypeAlterations EType
    s
                                ETyApp (ETyCon (ETCon String
    "Set")) EType
    s                 -> EType -> EType
    checkSet (EType -> EType) -> EType -> EType
    forall a b. (a -> b) -> a -> b
    $ EType -> EType
    defaultTypeAlterations EType
    s
                                ETyApp (ETyApp (ETyCon (ETCon String
    "HashMap")) EType
    k) EType
    v  -> EType -> EType -> EType
    checkMap (EType -> EType
    defaultTypeAlterations EType
    k) (EType -> EType
    defaultTypeAlterations EType
    v)
                                ETyApp (ETyApp (ETyCon (ETCon String
    "THashMap")) EType
    k) EType
    v -> EType -> EType -> EType
    checkMap (EType -> EType
    defaultTypeAlterations EType
    k) (EType -> EType
    defaultTypeAlterations EType
    v)
                                ETyApp (ETyCon (ETCon String
    "IntMap")) EType
    v              -> EType -> EType -> EType
    checkMap EType
    int (EType -> EType
    defaultTypeAlterations EType
    v)
                                ETyApp (ETyApp (ETyCon (ETCon String
    "Map")) EType
    k) EType
    v      -> EType -> EType -> EType
    checkMap (EType -> EType
    defaultTypeAlterations EType
    k) (EType -> EType
    defaultTypeAlterations EType
    v)
                                ETyApp (ETyApp (ETyCon (ETCon String
    "Tagged")) EType
    _) EType
    v   -> EType -> EType
    defaultTypeAlterations EType
    v
                                ETyApp EType
    x EType
    y                                      -> EType -> EType -> EType
    ETyApp (EType -> EType
    defaultTypeAlterations EType
    x) (EType -> EType
    defaultTypeAlterations EType
    y)
                                ETyCon (ETCon String
    "Integer")                        -> EType
    int
                                ETyCon (ETCon String
    "Natural")                        -> EType
    int
                                ETyCon (ETCon String
    "Int32")                          -> EType
    int
                                ETyCon (ETCon String
    "Int64")                          -> EType
    int
                                ETyCon (ETCon String
    "Text")                           -> String -> EType
    tc String
    "String"
                                ETyCon (ETCon String
    "Vector")                         -> String -> EType
    tc String
    "List"
                                ETyCon (ETCon String
    "Double")                         -> String -> EType
    tc String
    "Float"
                                ETyCon (ETCon String
    "UTCTime")                        -> String -> EType
    tc String
    "Posix"
                                EType
    _                                               -> EType
    t
        where
            int :: EType
    int = String -> EType
    tc String
    "Int"
            isComparable :: EType -> Bool
    isComparable (ETyCon (ETCon String
    n)) = String
    n String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String
    "String", String
    "Int", String
    "Float", String
    "Posix", String
    "Char"]
            isComparable EType
    _                  = Bool
    False -- TODO Lists and Tuples of comparable types
            tc :: String -> EType
    tc = ETCon -> EType
    ETyCon (ETCon -> EType) -> (String -> ETCon) -> String -> EType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ETCon
    ETCon
            checkMap :: EType -> EType -> EType
    checkMap EType
    k EType
    v | EType -> Bool
    isComparable EType
    k = EType -> EType -> EType
    ETyApp (EType -> EType -> EType
    ETyApp (String -> EType
    tc String
    "Dict") EType
    k) EType
    v
                         | Bool
    otherwise  = EType -> EType -> EType
    ETyApp (String -> EType
    tc String
    "List") (EType -> EType -> EType
    ETyApp (EType -> EType -> EType
    ETyApp (Int -> EType
    ETyTuple Int
    2) EType
    k) EType
    v)
            checkSet :: EType -> EType
    checkSet EType
    s | EType -> Bool
    isComparable EType
    s = EType -> EType -> EType
    ETyApp (String -> EType
    tc String
    "Set") EType
    s
                       | Bool
    otherwise = EType -> EType -> EType
    ETyApp (String -> EType
    tc String
    "List") EType
    s