elmental-0.1.0.0: src/Elmental/Generate.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module Elmental.Generate (
    generateTypeDef,
    generateEncoder,
    generateDecoder,
    generateAll,
    computeAll,
    mkSourceMap,
    include,
    outputModule,
    SomeStructure (..),
    ModuleDefinition (..),
) where

import Elmental

import Data.Foldable (toList, traverse_)
import Data.Function ((&))
import Data.List (foldl')
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes, fromJust, fromMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import NeatInterpolation (trimming, untrimming)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))

-- | Generate a type definition
generateTypeDef :: forall {k} (x :: k). (HasElmStructure k x) => Text
generateTypeDef = generateTypeDef' $ getElmStructure @x

generateTypeDef' :: DatatypeStructure x -> Text
generateTypeDef' DatatypeStructure{..}
    | (mapping.isTypeAlias && length constructors == 1 && null mapping.args && nParams == 0) =
        [trimming|
    type alias $tName =
      $aliasDef
  |]
    | (mapping.isTypeAlias && (length constructors /= 1 || not (null mapping.args) || nParams /= 0)) =
        error $ "Cannot generate an Elm type alias for: " <> show mapping.typeName
    | (not (null constructors) && null mapping.args) =
        [trimming|
    type $tName $tVars
      = $constructorDefs
  |]
  where
    tName = mapping.typeName
    currentModule = case mapping.moduleName of
        Nothing -> error $ "Cannot generate mapping for: " <> show mapping.typeName <> " (unknown module)"
        Just mName -> mName
    tVars = Text.intercalate " " (nToVarName <$> take (fromIntegral nParams) [0 ..])
    aliasDef = Text.intercalate "\n| " (renderAlias <$> constructors)
    constructorDefs = Text.intercalate "\n| " (renderConstructor <$> constructors)
    renderAlias Constructor{..} =
        case constructorFields of
            [] -> [trimming|{}|]
            _ ->
                let
                    renderedRecordFields = renderRecordFields constructorFields
                 in
                    [trimming|$renderedRecordFields|]

    renderConstructor Constructor{..} =
        case constructorFields of
            [] -> constructorName
            ((Nothing, _) : _) ->
                [trimming|
            $constructorName $renderedAnonymousFields
          |]
            ((Just _, _) : _) ->
                [trimming|
            $constructorName
                $renderedRecordFields
          |]
      where
        renderedAnonymousFields = renderAnonymousFields constructorFields
        renderedRecordFields = renderRecordFields constructorFields

    renderAnonymousFields = Text.intercalate " " . map (renderTyRef currentModule . snd)
    renderRecordFields fields =
        [trimming|
        { $renderedRecordFields
        }
      |]
      where
        renderedRecordFields = Text.intercalate "\n, " (renderField <$> fields)
        renderField (Just fieldName, tyRef) = mconcat [fieldName, " : ", renderTyRef currentModule tyRef]
        renderField a = error ("renderField - unmatched pattern:" ++ show a)

    nToVarName = Text.pack . ('a' :) . show @Integer
generateTypeDef' _ = error "Datatype has no constructor. Impossible to generate Elm definition."

-- | Generate a decoder
generateDecoder :: forall {k} (x :: k). (HasElmStructure k x) => Text
generateDecoder = generateDecoder' $ getElmStructure @x

generateDecoder' :: DatatypeStructure x -> Text
generateDecoder' DatatypeStructure{..} =
    [trimming|
    $decoderName : $decoderType
    $decoderName $decoderArgs =
      $decoderBody
  |]
  where
    decoderName = case mapping.decoderLocation of
        Just location -> location.symbolName
        Nothing -> error $ "No decoder location for: " <> show mapping.typeName
    decoderType =
        mconcat
            [ mconcat $ (\n -> "Decoder a" <> n <> " -> ") <$> params
            , "Decoder " <> fullTypeName
            ]
    decoderArgs =
        Text.intercalate " " $ ("d" <>) <$> params
    decoderBody = case constructors of
        [] ->
            error $ "Uninhabited datatype: " <> show mapping.typeName
        [singleConstructor] ->
            if mapping.isTypeAlias
                then decodeRecordAlias (mapping.typeName, mapping.moduleName) (singleConstructor.constructorFields)
                else decodeConstructor (mapping.typeName, mapping.moduleName) singleConstructor
        multiple ->
            (if all isNullary constructors then decodeStringTag fullTypeName ((.constructorName) <$> constructors) else decodeTaggedSum (mapping.typeName, mapping.moduleName) fullTypeName multiple)
    fullTypeName =
        case nParams of
            0 -> mapping.typeName
            _ ->
                let tVars = Text.intercalate " " $ ("a" <>) <$> params
                 in mconcat ["(", mapping.typeName, " ", tVars, ")"]

    params = (Text.pack . show @Integer) <$> take (fromIntegral nParams) [0 ..]

isNullary :: Constructor -> Bool
isNullary Constructor{..} = null constructorFields

decodeStringTag :: Text -> [ConstructorName] -> Text
decodeStringTag fullTypeName cNames =
    let tagBranches =
            Text.intercalate "\n" $
                (\name -> mconcat ["\"", name, "\" -> Json.Decode.succeed ", name])
                    <$> cNames
     in [trimming|
    let
      decide : String -> Decoder $fullTypeName
      decide tag =
        case tag of
          $tagBranches
          other ->
            Json.Decode.fail <| "$fullTypeName doesn't have constructor: " ++ other
    in
    Json.Decode.string
      |> Json.Decode.andThen decide
  |]

decodeTaggedSum :: (TypeName, Maybe ModuleName) -> Text -> [Constructor] -> Text
decodeTaggedSum recursionStop fullTypeName constructors =
    let tagBranches = Text.intercalate "\n" $ formatTagBranch recursionStop <$> constructors
     in [trimming|
    let
      decide : String -> Decoder $fullTypeName
      decide tag =
        case tag of
          $tagBranches
          other ->
            Json.Decode.fail <| "$fullTypeName doesn't have constructor: " ++ other
    in
    Json.Decode.field "tag" Json.Decode.string
     |> Json.Decode.andThen decide
  |]

formatTagBranch :: (TypeName, Maybe ModuleName) -> Constructor -> Text
formatTagBranch recursionStop constructor@Constructor{..} =
    let objectDecoder = decodeConstructor recursionStop constructor
     in [trimming|
    "$constructorName" ->
      $objectDecoder
  |]

decodeConstructor :: (TypeName, Maybe ModuleName) -> Constructor -> Text
decodeConstructor recursionStop Constructor{..} =
    case constructorFields of
        [] -> "Json.Decode.succeed " <> constructorName
        [(Nothing, tyRef)] ->
            mconcat
                [ [trimming|Json.Decode.field "contents" <||]
                , " Json.Decode.map "
                , constructorName
                , " "
                , mkTypeDecoder recursionStop tyRef
                ]
        fields@((Nothing, _) : _) -> decodeAnonymousConstructor recursionStop constructorName fields
        fields@((Just _, _) : _) -> decodeRecordConstructor recursionStop constructorName fields

decodeRecordConstructor :: (TypeName, Maybe ModuleName) -> ConstructorName -> [ElmField] -> Text
decodeRecordConstructor recursionStop cName fields =
    case fields of
        [] -> error "decodeRecordConstructor called on nullary constructor"
        fields' ->
            let mkFunction = mkFieldsFunction fields'
                fieldDecoders =
                    Text.intercalate "\n" $
                        mkFieldDecoder recursionStop <$> fields
             in [trimming|
        let mkFunction =
              $mkFunction
            contentDecoder =
              Json.Decode.succeed mkFunction
                $fieldDecoders
        in Json.Decode.field "contents" (Json.Decode.map $cName contentDecoder)
      |]

decodeRecordAlias :: (TypeName, Maybe ModuleName) -> [ElmField] -> Text
decodeRecordAlias recursionStop fields =
    case fields of
        [] -> [trimming| Json.Decode.succeed {} |]
        fields' ->
            let mkFunction = mkFieldsFunction fields'
                fieldDecoders =
                    Text.intercalate "\n" $
                        mkFieldDecoder recursionStop <$> fields
             in [trimming|
        let mkFunction =
              $mkFunction
            contentDecoder =
              Json.Decode.succeed mkFunction
                $fieldDecoders
        in contentDecoder
      |]

mkFieldDecoder :: (TypeName, Maybe ModuleName) -> ElmField -> Text
mkFieldDecoder recursionStop (Just fieldName, tyRef) =
    let typDecoder = mkTypeDecoder recursionStop tyRef
     in [trimming|
    |> andMap (Json.Decode.field "$fieldName" $typDecoder)
  |]
mkFieldDecoder _ a =
    error $ "mkFieldDecoder - unmatched pattern: " ++ show a

-- TODO: This recursion stop gimmmick only works if the type is directly recursive.
-- NOT if there is a cycle among decoders.
-- We should:
-- - Switch all decoder invocations to lazy as a MVP.
-- - Keep track of all types referend by a type and only insert lazy invocations where needed.
--   The performance hit may not be worth it.
mkTypeDecoder :: (TypeName, Maybe ModuleName) -> TyRef -> Text
mkTypeDecoder recursionStop@(tName, mName) TyRef{..} =
    case tyCon of
        TyVar varName -> "d" <> Text.tail varName -- TODO: Identify vars as ints, not strings.
        TyMapping mapping -> renderMapping tyArgs mapping
  where
    renderMapping :: [TyRef] -> ElmMapping -> Text
    renderMapping args mapping =
        let renderedArgs =
                Text.intercalate " " $
                    (renderMapping [] <$> mapping.args)
                        <> (mkTypeDecoder recursionStop <$> args)
         in if mapping.moduleName == mName && mapping.typeName == tName
                then -- Same module, same type: lazy decoding without module prefix.
                    "(Json.Decode.lazy (\\_ -> decode" <> tName <> " " <> renderedArgs <> "))"
                else
                    let decoderLocation = case mapping.decoderLocation of
                            Nothing -> error "No decoder"
                            Just location -> location
                        decodeFunction = (if mName == Just decoderLocation.symbolModuleName then (decoderLocation.symbolName) else decoderLocation.symbolModuleName <> "." <> decoderLocation.symbolName)
                     in case renderedArgs of
                            "" -> decodeFunction
                            _ -> "(" <> decodeFunction <> " " <> renderedArgs <> ")"

mkFieldsFunction :: [ElmField] -> Text
mkFieldsFunction fields =
    let fieldNames = (fromJust . fst) <$> fields
        args = Text.intercalate " " fieldNames
        fieldSetters = Text.intercalate "\n, " $ (\n -> n <> " = " <> n) <$> fieldNames
     in [trimming|
    \$args ->
      { $fieldSetters
      }
  |]

decodeAnonymousConstructor :: (TypeName, Maybe ModuleName) -> ConstructorName -> [ElmField] -> Text
decodeAnonymousConstructor recursionStop cName fields =
    let contentDecoder = case length fields of
            0 -> error "decodeAnonymous constructor should not be used for nullary constructors"
            1 -> "Json.Decode.map " <> cName <> mkTypeDecoder recursionStop (snd $ head fields)
            _ ->
                let numberedFields = zip @Integer [0 ..] (snd <$> fields)
                    mkFieldDecoder' (n, tyRef) =
                        "|> andMap (Json.Decode.index "
                            <> Text.pack (show n)
                            <> " "
                            <> mkTypeDecoder recursionStop tyRef
                            <> ")"
                    fieldDecoders = Text.intercalate "\n" $ mkFieldDecoder' <$> numberedFields
                 in [trimming|
            Json.Decode.succeed $cName
              $fieldDecoders
          |]
     in [trimming|
    let contentDecoder =
          $contentDecoder
    in
    Json.Decode.field "contents" contentDecoder
  |]

-- | Generate an encoder
generateEncoder :: forall {k} (x :: k). (HasElmStructure k x) => Text
generateEncoder = generateEncoder' $ getElmStructure @x

getEncoderLocation :: DatatypeStructure x -> SymbolLocation
getEncoderLocation DatatypeStructure{..} =
    case mapping.encoderLocation of
        Nothing -> error $ "No encoder location for: " <> show mapping.typeName
        Just location -> location

getEncoderName :: DatatypeStructure x -> Text
getEncoderName = (.symbolName) . getEncoderLocation

getEncoderModule :: DatatypeStructure x -> Text
getEncoderModule = (.symbolModuleName) . getEncoderLocation

generateEncoder' :: DatatypeStructure x -> Text
generateEncoder' structure@(DatatypeStructure{..})
    | mapping.isTypeAlias =
        [trimming|
    $encoderName : $encoderType
    $defLineAlias
      $bodyAlias
  |]
    | otherwise =
        [trimming|
    $encoderName : $encoderType
    $defLine
      $body
  |]
  where
    encoderName = structure & getEncoderName
    encoderType = mkEncoderType structure
    defLine = mkEncoderDefLine structure
    defLineAlias = mkEncoderDefLineAlias structure
    body = mkEncoderBody structure
    bodyAlias = mkEncoderBodyAlias structure

mkEncoderType :: DatatypeStructure x -> Text
mkEncoderType structure =
    Text.intercalate " " $
        mconcat
            [ paramEncoderTypes
            , [qualifiedTypeNameAt structure (structure & getEncoderLocation), "->", "Value"]
            ]
  where
    paramEncoderTypes =
        ((\n -> "(e" <> n <> " -> Value) ->") . (Text.pack . show @Integer))
            <$> take (fromIntegral structure.nParams) [0 ..]

mkEncoderDefLine :: DatatypeStructure x -> Text
mkEncoderDefLine structure =
    Text.intercalate " " $
        mconcat
            [ [getEncoderName structure]
            , (("e" <>) . Text.pack . show @Integer) <$> take (fromIntegral structure.nParams) [0 ..]
            , ["v", "="]
            ]

mkEncoderDefLineAlias :: DatatypeStructure x -> Text
mkEncoderDefLineAlias structure =
    Text.intercalate " " $
        mconcat
            [ [getEncoderName structure]
            , (("e" <>) . Text.pack . show @Integer) <$> take (fromIntegral structure.nParams) [0 ..]
            , ["r", "="]
            ]

qualifiedTypeNameAt :: DatatypeStructure x -> SymbolLocation -> Text
qualifiedTypeNameAt s@(DatatypeStructure{..}) loc =
    let tName = case mapping.moduleName of
            Nothing -> mapping.typeName
            Just _ -> prefixFor s loc <> mapping.typeName
        tArgs = (("e" <>) . Text.pack . show @Integer) <$> take (fromIntegral s.nParams) [0 ..]
        allComponents = tName : tArgs
     in case allComponents of
            [single] -> single
            _multiple -> "(" <> Text.intercalate " " allComponents <> ")"

prefixFor :: DatatypeStructure x -> SymbolLocation -> Text
prefixFor DatatypeStructure{..} loc =
    case (mapping.moduleName, loc.symbolModuleName) of
        (Nothing, _) -> ""
        (Just m1, m2) -> if m1 == m2 then "" else m1 <> "."

mkEncoderBody :: DatatypeStructure x -> Text
mkEncoderBody structure@(DatatypeStructure{..}) =
    [trimming|
    case v of
      $constructorBranches
  |]
  where
    constructorBranches = case constructors of
        [] ->
            error $
                "Cannot generate encoder body (no constructors): "
                    <> show structure.mapping.typeName
        [singleConstructor] ->
            unwrapConstructorBranch structure singleConstructor
        multiple ->
            multipleConstructorBranches structure multiple

mkEncoderBodyAlias :: DatatypeStructure x -> Text
mkEncoderBodyAlias structure@(DatatypeStructure{..}) =
    [trimming|
    $constructorBranches
  |]
  where
    constructorBranches = case constructors of
        [] ->
            error $
                "Cannot generate encoder body (no constructors): "
                    <> show structure.mapping.typeName
        [singleConstructor] ->
            let (_, _, contentEncoder) = constructorBranchHelper structure singleConstructor
             in -- Single constructor with no field is encoded as an empty list
                fromMaybe "Json.Encode.list identity []" contentEncoder
        _ ->
            error $
                "Cannot generate encoder body as type alias (too many constructors): "
                    <> show structure.mapping.typeName

unwrapConstructorBranch :: DatatypeStructure x -> Constructor -> Text
unwrapConstructorBranch s@(DatatypeStructure{}) c =
    let (cName, cArgs, contentEncoder) = constructorBranchHelper s c
        matchLine = Text.intercalate " " (cName : cArgs)
     in foldMap
            ( \e ->
                [trimming|
                       $matchLine ->
                         $e
                       |]
            )
            contentEncoder

constructorBranchHelper :: DatatypeStructure x -> Constructor -> (Text, [Text], Maybe Text)
constructorBranchHelper s@(DatatypeStructure{}) c =
    (cName, cArgs, contentEncoder)
  where
    cName = prefixFor s (s & getEncoderLocation) <> c.constructorName
    nFields = length c.constructorFields
    contentEncoder = case c.constructorFields of
        [] ->
            -- Single constructor with no field has no content field
            Nothing
        [(Nothing, tyRef)] ->
            -- Newtype-like: we directly encode the value
            Just $ encoderForType s tyRef <> " " <> "p0"
        ((Nothing, _tyRef) : _) ->
            -- Multiple anonymous fields: encode positionally, as a list.
            let encodedValues =
                    Text.intercalate "\n, " $
                        (\(n, (_, tyRef)) -> encoderForType s tyRef <> " p" <> Text.pack (show n))
                            <$> (zip @Integer [0 ..] c.constructorFields)
             in Just
                    [trimming|
          Json.Encode.list identity
            [ $encodedValues
            ]
        |]
        recordFields ->
            let encodedPairs =
                    Text.intercalate "\n, " $
                        ( \case
                            (Just fieldName, tyRef) -> encodePair fieldName tyRef
                            a -> error $ "unmatched pattern in constructorBranchHelper: " ++ show a
                        )
                            <$> recordFields
                encodePair fieldName tyRef =
                    "(\""
                        <> fieldName
                        <> "\", "
                        <> encoderForType s tyRef
                        <> " r."
                        <> fieldName
                        <> ")"
             in Just
                    [trimming|
          Json.Encode.object
            [ $encodedPairs
            ]
        |]
    cArgs = case c.constructorFields of
        [] -> []
        ((Just _, _) : _) -> ["r"]
        _ ->
            -- Anonymous fields
            (("p" <>) . Text.pack . show @Integer) <$> take nFields [0 ..]

multipleConstructorBranches :: DatatypeStructure x -> [Constructor] -> Text
multipleConstructorBranches structure constructors =
    let prefix = (prefixFor structure (structure & getEncoderLocation))
     in (if all isNullary constructors then encodeStringTags prefix ((.constructorName) <$> constructors) else encodeTaggedBranches structure constructors)

encodeStringTags :: Text -> [ConstructorName] -> Text
encodeStringTags prefix cnames =
    Text.intercalate "\n" $
        (\cname -> prefix <> cname <> " -> Json.Encode.string \"" <> cname <> "\"") <$> cnames

encodeTaggedBranches :: DatatypeStructure x -> [Constructor] -> Text
encodeTaggedBranches ds cs = Text.intercalate "\n" $ mkTagBranch <$> cs
  where
    mkTagBranch c =
        let (cName, cArgs, encodedContent) =
                constructorBranchHelper ds c
            match = Text.intercalate " " (cName : cArgs)
            tag = c.constructorName
            contentsField =
                foldMap
                    ( \val ->
                        [untrimming|
                           , ( "contents"
                             , $val
                             )
                           |]
                    )
                    encodedContent
         in [trimming|
            $match -> Json.Encode.object
              [ ( "tag", Json.Encode.string "$tag" )$contentsField]
          |]

encoderForType :: DatatypeStructure x -> TyRef -> Text
encoderForType ds TyRef{..} =
    case tyCon of
        TyVar varName -> "e" <> Text.tail varName -- Won't have args (No HKTs)
        TyMapping mapping -> renderMapping mapping
  where
    renderMapping mapping =
        let encoderName = case mapping.encoderLocation of
                Nothing -> error $ "Could not find encoder for type: " <> show mapping.typeName
                Just location ->
                    (if location.symbolModuleName == getEncoderModule ds then (location.symbolName) else location.symbolModuleName <> "." <> location.symbolName)
            paramEncoders =
                (renderMapping <$> mapping.args)
                    <> (encoderForType ds <$> tyArgs)
         in "(" <> Text.intercalate " " (encoderName : paramEncoders) <> ")"

--
data SomeStructure = forall x. SomeStructure (DatatypeStructure x)
include :: forall {k} x. (HasElmStructure k x) => SomeStructure
include = SomeStructure $ getElmStructure @x

data ModuleDefinition = ModuleDefinition
    { imports :: Set ModuleName
    , typeDefs :: [Text]
    , encoders :: [Text]
    , decoders :: [Text]
    }
    deriving (Eq, Show)

instance Semigroup ModuleDefinition where
    m1 <> m2 =
        ModuleDefinition
            { imports = Set.union m1.imports m2.imports
            , typeDefs = m1.typeDefs <> m2.typeDefs
            , encoders = m1.encoders <> m2.encoders
            , decoders = m1.decoders <> m2.decoders
            }
instance Monoid ModuleDefinition where
    mempty = ModuleDefinition mempty mempty mempty mempty

generateAll :: FilePath -> [SomeStructure] -> IO ()
generateAll baseDir ds = do
    let srcMap = mkSourceMap ds
    traverse_ (outputModule baseDir) $ Map.toAscList srcMap

mkSourceMap :: [SomeStructure] -> Map ModuleName Text
mkSourceMap ds = Map.mapWithKey renderModule $ computeAll ds

outputModule :: FilePath -> (ModuleName, Text) -> IO ()
outputModule baseDir (mName, source) = do
    let fileDir = baseDir </> relDir
        filePath = fileDir </> fileName
        fileName = fileComponent <> ".elm"
        relDir = foldl' (</>) "" dirComponents
        fileComponent = head reversed
        dirComponents = reverse $ drop 1 reversed
        reversed = reverse moduleComponents
        moduleComponents = Text.unpack <$> Text.split (== '.') mName
    createDirectoryIfMissing True fileDir
    Text.writeFile filePath source

renderModule :: ModuleName -> ModuleDefinition -> Text
renderModule mName ModuleDefinition{..} =
    [trimming|
    module $mName exposing (..)

    $importsSrc
    import Json.Encode
    import Json.Encode exposing (Value)
    import Json.Decode
    import Json.Decode exposing (Decoder)
    import Json.Decode.Extra exposing (andMap)


    $typeDefsSrc

    $encodersSrc

    $decodersSrc
  |]
  where
    typeDefsSrc = Text.intercalate "\n\n" typeDefs
    encodersSrc = Text.intercalate "\n\n" encoders
    decodersSrc = Text.intercalate "\n\n" decoders
    importsSrc = Text.unlines $ ("import " <>) <$> (Set.toAscList imports)

computeAll :: [SomeStructure] -> Map ModuleName ModuleDefinition
computeAll = foldl' addToModules Map.empty . mconcat . fmap mkModuleDefs
  where
    addToModules modules (mName, def) =
        Map.insertWith (<>) mName def modules
    mkModuleDefs (SomeStructure ds) =
        let constructorImports = Set.fromList $ mconcat $ getImports <$> ds.constructors
            typeImport = Set.fromList $ toList ds.mapping.moduleName
         in catMaybes
                [ case ds.mapping.moduleName of
                    Nothing -> Nothing
                    Just mName -> Just (mName, mDef)
                      where
                        mDef =
                            mempty
                                { imports = Set.delete mName constructorImports
                                , typeDefs = pure $ generateTypeDef' ds
                                }
                , case ds.mapping.encoderLocation of
                    Nothing -> Nothing
                    Just encoder -> Just (encoder.symbolModuleName, mDef)
                      where
                        mDef =
                            mempty
                                { imports =
                                    Set.delete
                                        encoder.symbolModuleName
                                        (constructorImports `Set.union` typeImport)
                                , encoders = pure $ generateEncoder' ds
                                }
                , case ds.mapping.decoderLocation of
                    Nothing -> Nothing
                    Just decoder -> Just (decoder.symbolModuleName, mDef)
                      where
                        mDef =
                            mempty
                                { imports =
                                    Set.delete
                                        decoder.symbolModuleName
                                        (constructorImports `Set.union` typeImport)
                                , decoders = pure $ generateDecoder' ds
                                }
                ]

getImports :: Constructor -> [Text]
getImports Constructor{..} = mconcat $ getFieldImports <$> constructorFields
  where
    getFieldImports (_, tyRef) = getTypeImports tyRef
    getTypeImports :: TyRef -> [Text]
    getTypeImports tyRef =
        mconcat
            [ (mconcat $ getTypeImports <$> tyRef.tyArgs)
            , mappingArgs tyRef.tyCon
            ]
    mappingArgs tyCon = case tyCon of
        TyMapping mapping ->
            toList mapping.moduleName
                <> toList ((.symbolModuleName) <$> mapping.encoderLocation)
                <> toList ((.symbolModuleName) <$> mapping.decoderLocation)
                <> mconcat (mappingArgs . TyMapping <$> mapping.args)
        _ -> mempty

-- Utility functions
renderTyRef :: ModuleName -> TyRef -> Text
renderTyRef currentModule tyRef =
    wrapIfNeeded allRendered
  where
    wrapIfNeeded :: [Text] -> Text
    wrapIfNeeded xs = case xs of
        [single] -> single
        _multiple -> "(" <> Text.intercalate " " xs <> ")"

    allRendered :: [Text]
    allRendered =
        renderTyCon tyRef.tyCon <> (renderTyRef currentModule <$> tyRef.tyArgs)

    renderTyCon :: TyCon -> [Text]
    renderTyCon tyCon = case tyCon of
        TyVar v -> [v]
        TyMapping mapping -> renderMapping mapping

    mkTyCon :: ElmMapping -> Text
    mkTyCon mapping = case mapping.moduleName of
        Nothing -> mapping.typeName
        Just mName -> (if mName == currentModule then (mapping.typeName) else mName <> "." <> mapping.typeName)

    renderMapping :: ElmMapping -> [Text]
    renderMapping mapping =
        (mkTyCon mapping)
            : ((wrapIfNeeded . renderMapping) <$> mapping.args)