{-# 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 :: forall {k} (x :: k). HasElmStructure k x => ModuleName
generateTypeDef = DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
generateTypeDef' (DatatypeStructure x -> ModuleName)
-> DatatypeStructure x -> ModuleName
forall a b. (a -> b) -> a -> b
$ forall (x :: k). HasElmStructure k x => DatatypeStructure x
forall {k} (x :: k). HasElmStructure k x => DatatypeStructure x
getElmStructure @x

generateTypeDef' :: DatatypeStructure x -> Text
generateTypeDef' :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
generateTypeDef' DatatypeStructure{Integer
[Constructor]
ElmMapping
mapping :: ElmMapping
nParams :: Integer
constructors :: [Constructor]
$sel:mapping:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> ElmMapping
$sel:nParams:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> Integer
$sel:constructors:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> [Constructor]
..}
    | (ElmMapping
mapping.isTypeAlias Bool -> Bool -> Bool
&& [Constructor] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constructor]
constructors Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& [ElmMapping] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ElmMapping
mapping.args Bool -> Bool -> Bool
&& Integer
nParams Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) =
        [trimming|
    type alias $tName =
      $aliasDef
  |]
    | (ElmMapping
mapping.isTypeAlias Bool -> Bool -> Bool
&& ([Constructor] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constructor]
constructors Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 Bool -> Bool -> Bool
|| Bool -> Bool
not ([ElmMapping] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ElmMapping
mapping.args) Bool -> Bool -> Bool
|| Integer
nParams Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)) =
        [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot generate an Elm type alias for: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [Char]
forall a. Show a => a -> [Char]
show ElmMapping
mapping.typeName
    | (Bool -> Bool
not ([Constructor] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constructor]
constructors) Bool -> Bool -> Bool
&& [ElmMapping] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ElmMapping
mapping.args) =
        [trimming|
    type $tName $tVars
      = $constructorDefs
  |]
  where
    tName :: ModuleName
tName = ElmMapping
mapping.typeName
    currentModule :: ModuleName
currentModule = case ElmMapping
mapping.moduleName of
        Maybe ModuleName
Nothing -> [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot generate mapping for: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [Char]
forall a. Show a => a -> [Char]
show ElmMapping
mapping.typeName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" (unknown module)"
        Just ModuleName
mName -> ModuleName
mName
    tVars :: ModuleName
tVars = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " (Integer -> ModuleName
nToVarName (Integer -> ModuleName) -> [Integer] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nParams) [Integer
0 ..])
    aliasDef :: ModuleName
aliasDef = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n| " (Constructor -> ModuleName
renderAlias (Constructor -> ModuleName) -> [Constructor] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constructor]
constructors)
    constructorDefs :: ModuleName
constructorDefs = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n| " (Constructor -> ModuleName
renderConstructor (Constructor -> ModuleName) -> [Constructor] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constructor]
constructors)
    renderAlias :: Constructor -> ModuleName
renderAlias Constructor{[ElmField]
ModuleName
constructorName :: ModuleName
constructorFields :: [ElmField]
$sel:constructorName:Constructor :: Constructor -> ModuleName
$sel:constructorFields:Constructor :: Constructor -> [ElmField]
..} =
        case [ElmField]
constructorFields of
            [] -> [trimming|{}|]
            [ElmField]
_ ->
                let
                    renderedRecordFields :: ModuleName
renderedRecordFields = [ElmField] -> ModuleName
renderRecordFields [ElmField]
constructorFields
                 in
                    [trimming|$renderedRecordFields|]

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

    renderAnonymousFields :: [(a, TyRef)] -> ModuleName
renderAnonymousFields = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " ([ModuleName] -> ModuleName)
-> ([(a, TyRef)] -> [ModuleName]) -> [(a, TyRef)] -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, TyRef) -> ModuleName) -> [(a, TyRef)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> TyRef -> ModuleName
renderTyRef ModuleName
currentModule (TyRef -> ModuleName)
-> ((a, TyRef) -> TyRef) -> (a, TyRef) -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, TyRef) -> TyRef
forall a b. (a, b) -> b
snd)
    renderRecordFields :: [ElmField] -> ModuleName
renderRecordFields [ElmField]
fields =
        [trimming|
        { $renderedRecordFields
        }
      |]
      where
        renderedRecordFields :: ModuleName
renderedRecordFields = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n, " (ElmField -> ModuleName
renderField (ElmField -> ModuleName) -> [ElmField] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElmField]
fields)
        renderField :: ElmField -> ModuleName
renderField (Just ModuleName
fieldName, TyRef
tyRef) = [ModuleName] -> ModuleName
forall a. Monoid a => [a] -> a
mconcat [ModuleName
fieldName, ModuleName
" : ", ModuleName -> TyRef -> ModuleName
renderTyRef ModuleName
currentModule TyRef
tyRef]
        renderField ElmField
a = [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char]
"renderField - unmatched pattern:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ElmField -> [Char]
forall a. Show a => a -> [Char]
show ElmField
a)

    nToVarName :: Integer -> ModuleName
nToVarName = [Char] -> ModuleName
Text.pack ([Char] -> ModuleName)
-> (Integer -> [Char]) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'a' :) ([Char] -> [Char]) -> (Integer -> [Char]) -> Integer -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show @Integer
generateTypeDef' DatatypeStructure x
_ = [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error [Char]
"Datatype has no constructor. Impossible to generate Elm definition."

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

generateDecoder' :: DatatypeStructure x -> Text
generateDecoder' :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
generateDecoder' DatatypeStructure{Integer
[Constructor]
ElmMapping
$sel:mapping:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> ElmMapping
$sel:nParams:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> Integer
$sel:constructors:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> [Constructor]
mapping :: ElmMapping
nParams :: Integer
constructors :: [Constructor]
..} =
    [trimming|
    $decoderName : $decoderType
    $decoderName $decoderArgs =
      $decoderBody
  |]
  where
    decoderName :: ModuleName
decoderName = case ElmMapping
mapping.decoderLocation of
        Just SymbolLocation
location -> SymbolLocation
location.symbolName
        Maybe SymbolLocation
Nothing -> [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Char]
"No decoder location for: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [Char]
forall a. Show a => a -> [Char]
show ElmMapping
mapping.typeName
    decoderType :: ModuleName
decoderType =
        [ModuleName] -> ModuleName
forall a. Monoid a => [a] -> a
mconcat
            [ [ModuleName] -> ModuleName
forall a. Monoid a => [a] -> a
mconcat ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ (\ModuleName
n -> ModuleName
"Decoder a" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
n ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
" -> ") (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
params
            , ModuleName
"Decoder " ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
fullTypeName
            ]
    decoderArgs :: ModuleName
decoderArgs =
        ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ (ModuleName
"d" <>) (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
params
    decoderBody :: ModuleName
decoderBody = case [Constructor]
constructors of
        [] ->
            [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Char]
"Uninhabited datatype: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [Char]
forall a. Show a => a -> [Char]
show ElmMapping
mapping.typeName
        [Constructor
singleConstructor] ->
            if ElmMapping
mapping.isTypeAlias
                then (ModuleName, Maybe ModuleName) -> [ElmField] -> ModuleName
decodeRecordAlias (ElmMapping
mapping.typeName, ElmMapping
mapping.moduleName) (Constructor
singleConstructor.constructorFields)
                else (ModuleName, Maybe ModuleName) -> Constructor -> ModuleName
decodeConstructor (ElmMapping
mapping.typeName, ElmMapping
mapping.moduleName) Constructor
singleConstructor
        [Constructor]
multiple ->
            (if (Constructor -> Bool) -> [Constructor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Constructor -> Bool
isNullary [Constructor]
constructors then ModuleName -> [ModuleName] -> ModuleName
decodeStringTag ModuleName
fullTypeName ((.constructorName) (Constructor -> ModuleName) -> [Constructor] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constructor]
constructors) else (ModuleName, Maybe ModuleName)
-> ModuleName -> [Constructor] -> ModuleName
decodeTaggedSum (ElmMapping
mapping.typeName, ElmMapping
mapping.moduleName) ModuleName
fullTypeName [Constructor]
multiple)
    fullTypeName :: ModuleName
fullTypeName =
        case Integer
nParams of
            Integer
0 -> ElmMapping
mapping.typeName
            Integer
_ ->
                let tVars :: ModuleName
tVars = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ (ModuleName
"a" <>) (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
params
                 in [ModuleName] -> ModuleName
forall a. Monoid a => [a] -> a
mconcat [ModuleName
"(", ElmMapping
mapping.typeName, ModuleName
" ", ModuleName
tVars, ModuleName
")"]

    params :: [ModuleName]
params = ([Char] -> ModuleName
Text.pack ([Char] -> ModuleName)
-> (Integer -> [Char]) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show @Integer) (Integer -> ModuleName) -> [Integer] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nParams) [Integer
0 ..]

isNullary :: Constructor -> Bool
isNullary :: Constructor -> Bool
isNullary Constructor{[ElmField]
ModuleName
$sel:constructorName:Constructor :: Constructor -> ModuleName
$sel:constructorFields:Constructor :: Constructor -> [ElmField]
constructorName :: ModuleName
constructorFields :: [ElmField]
..} = [ElmField] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ElmField]
constructorFields

decodeStringTag :: Text -> [ConstructorName] -> Text
decodeStringTag :: ModuleName -> [ModuleName] -> ModuleName
decodeStringTag ModuleName
fullTypeName [ModuleName]
cNames =
    let tagBranches :: ModuleName
tagBranches =
            ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n" ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
                (\ModuleName
name -> [ModuleName] -> ModuleName
forall a. Monoid a => [a] -> a
mconcat [ModuleName
"\"", ModuleName
name, ModuleName
"\" -> Json.Decode.succeed ", ModuleName
name])
                    (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
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 :: (ModuleName, Maybe ModuleName)
-> ModuleName -> [Constructor] -> ModuleName
decodeTaggedSum (ModuleName, Maybe ModuleName)
recursionStop ModuleName
fullTypeName [Constructor]
constructors =
    let tagBranches :: ModuleName
tagBranches = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n" ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ (ModuleName, Maybe ModuleName) -> Constructor -> ModuleName
formatTagBranch (ModuleName, Maybe ModuleName)
recursionStop (Constructor -> ModuleName) -> [Constructor] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constructor]
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 :: (ModuleName, Maybe ModuleName) -> Constructor -> ModuleName
formatTagBranch (ModuleName, Maybe ModuleName)
recursionStop constructor :: Constructor
constructor@Constructor{[ElmField]
ModuleName
$sel:constructorName:Constructor :: Constructor -> ModuleName
$sel:constructorFields:Constructor :: Constructor -> [ElmField]
constructorName :: ModuleName
constructorFields :: [ElmField]
..} =
    let objectDecoder :: ModuleName
objectDecoder = (ModuleName, Maybe ModuleName) -> Constructor -> ModuleName
decodeConstructor (ModuleName, Maybe ModuleName)
recursionStop Constructor
constructor
     in [trimming|
    "$constructorName" ->
      $objectDecoder
  |]

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

decodeRecordConstructor :: (TypeName, Maybe ModuleName) -> ConstructorName -> [ElmField] -> Text
decodeRecordConstructor :: (ModuleName, Maybe ModuleName)
-> ModuleName -> [ElmField] -> ModuleName
decodeRecordConstructor (ModuleName, Maybe ModuleName)
recursionStop ModuleName
cName [ElmField]
fields =
    case [ElmField]
fields of
        [] -> [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error [Char]
"decodeRecordConstructor called on nullary constructor"
        [ElmField]
fields' ->
            let mkFunction :: ModuleName
mkFunction = [ElmField] -> ModuleName
mkFieldsFunction [ElmField]
fields'
                fieldDecoders :: ModuleName
fieldDecoders =
                    ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n" ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
                        (ModuleName, Maybe ModuleName) -> ElmField -> ModuleName
mkFieldDecoder (ModuleName, Maybe ModuleName)
recursionStop (ElmField -> ModuleName) -> [ElmField] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElmField]
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 :: (ModuleName, Maybe ModuleName) -> [ElmField] -> ModuleName
decodeRecordAlias (ModuleName, Maybe ModuleName)
recursionStop [ElmField]
fields =
    case [ElmField]
fields of
        [] -> [trimming| Json.Decode.succeed {} |]
        [ElmField]
fields' ->
            let mkFunction :: ModuleName
mkFunction = [ElmField] -> ModuleName
mkFieldsFunction [ElmField]
fields'
                fieldDecoders :: ModuleName
fieldDecoders =
                    ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n" ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
                        (ModuleName, Maybe ModuleName) -> ElmField -> ModuleName
mkFieldDecoder (ModuleName, Maybe ModuleName)
recursionStop (ElmField -> ModuleName) -> [ElmField] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElmField]
fields
             in [trimming|
        let mkFunction =
              $mkFunction
            contentDecoder =
              Json.Decode.succeed mkFunction
                $fieldDecoders
        in contentDecoder
      |]

mkFieldDecoder :: (TypeName, Maybe ModuleName) -> ElmField -> Text
mkFieldDecoder :: (ModuleName, Maybe ModuleName) -> ElmField -> ModuleName
mkFieldDecoder (ModuleName, Maybe ModuleName)
recursionStop (Just ModuleName
fieldName, TyRef
tyRef) =
    let typDecoder :: ModuleName
typDecoder = (ModuleName, Maybe ModuleName) -> TyRef -> ModuleName
mkTypeDecoder (ModuleName, Maybe ModuleName)
recursionStop TyRef
tyRef
     in [trimming|
    |> andMap (Json.Decode.field "$fieldName" $typDecoder)
  |]
mkFieldDecoder (ModuleName, Maybe ModuleName)
_ ElmField
a =
    [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Char]
"mkFieldDecoder - unmatched pattern: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ElmField -> [Char]
forall a. Show a => a -> [Char]
show ElmField
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 :: (ModuleName, Maybe ModuleName) -> TyRef -> ModuleName
mkTypeDecoder recursionStop :: (ModuleName, Maybe ModuleName)
recursionStop@(ModuleName
tName, Maybe ModuleName
mName) TyRef{[TyRef]
TyCon
tyCon :: TyCon
tyArgs :: [TyRef]
$sel:tyCon:TyRef :: TyRef -> TyCon
$sel:tyArgs:TyRef :: TyRef -> [TyRef]
..} =
    case TyCon
tyCon of
        TyVar ModuleName
varName -> ModuleName
"d" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> HasCallStack => ModuleName -> ModuleName
ModuleName -> ModuleName
Text.tail ModuleName
varName -- TODO: Identify vars as ints, not strings.
        TyMapping ElmMapping
mapping -> [TyRef] -> ElmMapping -> ModuleName
renderMapping [TyRef]
tyArgs ElmMapping
mapping
  where
    renderMapping :: [TyRef] -> ElmMapping -> Text
    renderMapping :: [TyRef] -> ElmMapping -> ModuleName
renderMapping [TyRef]
args ElmMapping
mapping =
        let renderedArgs :: ModuleName
renderedArgs =
                ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
                    ([TyRef] -> ElmMapping -> ModuleName
renderMapping [] (ElmMapping -> ModuleName) -> [ElmMapping] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElmMapping
mapping.args)
                        [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> ((ModuleName, Maybe ModuleName) -> TyRef -> ModuleName
mkTypeDecoder (ModuleName, Maybe ModuleName)
recursionStop (TyRef -> ModuleName) -> [TyRef] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyRef]
args)
         in if ElmMapping
mapping.moduleName Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ModuleName
mName Bool -> Bool -> Bool
&& ElmMapping
mapping.typeName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
tName
                then -- Same module, same type: lazy decoding without module prefix.
                    ModuleName
"(Json.Decode.lazy (\\_ -> decode" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
tName ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
" " ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
renderedArgs ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
"))"
                else
                    let decoderLocation :: SymbolLocation
decoderLocation = case ElmMapping
mapping.decoderLocation of
                            Maybe SymbolLocation
Nothing -> [Char] -> SymbolLocation
forall a. HasCallStack => [Char] -> a
error [Char]
"No decoder"
                            Just SymbolLocation
location -> SymbolLocation
location
                        decodeFunction :: ModuleName
decodeFunction = (if Maybe ModuleName
mName Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just SymbolLocation
decoderLocation.symbolModuleName then (SymbolLocation
decoderLocation.symbolName) else SymbolLocation
decoderLocation.symbolModuleName ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
"." ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> SymbolLocation
decoderLocation.symbolName)
                     in case ModuleName
renderedArgs of
                            ModuleName
"" -> ModuleName
decodeFunction
                            ModuleName
_ -> ModuleName
"(" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
decodeFunction ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
" " ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
renderedArgs ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
")"

mkFieldsFunction :: [ElmField] -> Text
mkFieldsFunction :: [ElmField] -> ModuleName
mkFieldsFunction [ElmField]
fields =
    let fieldNames :: [ModuleName]
fieldNames = (Maybe ModuleName -> ModuleName
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ModuleName -> ModuleName)
-> (ElmField -> Maybe ModuleName) -> ElmField -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElmField -> Maybe ModuleName
forall a b. (a, b) -> a
fst) (ElmField -> ModuleName) -> [ElmField] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElmField]
fields
        args :: ModuleName
args = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " [ModuleName]
fieldNames
        fieldSetters :: ModuleName
fieldSetters = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n, " ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ (\ModuleName
n -> ModuleName
n ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
" = " ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
n) (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
fieldNames
     in [trimming|
    \$args ->
      { $fieldSetters
      }
  |]

decodeAnonymousConstructor :: (TypeName, Maybe ModuleName) -> ConstructorName -> [ElmField] -> Text
decodeAnonymousConstructor :: (ModuleName, Maybe ModuleName)
-> ModuleName -> [ElmField] -> ModuleName
decodeAnonymousConstructor (ModuleName, Maybe ModuleName)
recursionStop ModuleName
cName [ElmField]
fields =
    let contentDecoder :: ModuleName
contentDecoder = case [ElmField] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ElmField]
fields of
            Int
0 -> [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error [Char]
"decodeAnonymous constructor should not be used for nullary constructors"
            Int
1 -> ModuleName
"Json.Decode.map " ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
cName ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> (ModuleName, Maybe ModuleName) -> TyRef -> ModuleName
mkTypeDecoder (ModuleName, Maybe ModuleName)
recursionStop (ElmField -> TyRef
forall a b. (a, b) -> b
snd (ElmField -> TyRef) -> ElmField -> TyRef
forall a b. (a -> b) -> a -> b
$ [ElmField] -> ElmField
forall a. HasCallStack => [a] -> a
head [ElmField]
fields)
            Int
_ ->
                let numberedFields :: [(Integer, TyRef)]
numberedFields = forall a b. [a] -> [b] -> [(a, b)]
zip @Integer [Integer
0 ..] (ElmField -> TyRef
forall a b. (a, b) -> b
snd (ElmField -> TyRef) -> [ElmField] -> [TyRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElmField]
fields)
                    mkFieldDecoder' :: (a, TyRef) -> ModuleName
mkFieldDecoder' (a
n, TyRef
tyRef) =
                        ModuleName
"|> andMap (Json.Decode.index "
                            ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> [Char] -> ModuleName
Text.pack (a -> [Char]
forall a. Show a => a -> [Char]
show a
n)
                            ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
" "
                            ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> (ModuleName, Maybe ModuleName) -> TyRef -> ModuleName
mkTypeDecoder (ModuleName, Maybe ModuleName)
recursionStop TyRef
tyRef
                            ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
")"
                    fieldDecoders :: ModuleName
fieldDecoders = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n" ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ (Integer, TyRef) -> ModuleName
forall {a}. Show a => (a, TyRef) -> ModuleName
mkFieldDecoder' ((Integer, TyRef) -> ModuleName)
-> [(Integer, TyRef)] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Integer, TyRef)]
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 :: forall {k} (x :: k). HasElmStructure k x => ModuleName
generateEncoder = DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
generateEncoder' (DatatypeStructure x -> ModuleName)
-> DatatypeStructure x -> ModuleName
forall a b. (a -> b) -> a -> b
$ forall (x :: k). HasElmStructure k x => DatatypeStructure x
forall {k} (x :: k). HasElmStructure k x => DatatypeStructure x
getElmStructure @x

getEncoderLocation :: DatatypeStructure x -> SymbolLocation
getEncoderLocation :: forall {k} (x :: k). DatatypeStructure x -> SymbolLocation
getEncoderLocation DatatypeStructure{Integer
[Constructor]
ElmMapping
$sel:mapping:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> ElmMapping
$sel:nParams:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> Integer
$sel:constructors:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> [Constructor]
mapping :: ElmMapping
nParams :: Integer
constructors :: [Constructor]
..} =
    case ElmMapping
mapping.encoderLocation of
        Maybe SymbolLocation
Nothing -> [Char] -> SymbolLocation
forall a. HasCallStack => [Char] -> a
error ([Char] -> SymbolLocation) -> [Char] -> SymbolLocation
forall a b. (a -> b) -> a -> b
$ [Char]
"No encoder location for: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [Char]
forall a. Show a => a -> [Char]
show ElmMapping
mapping.typeName
        Just SymbolLocation
location -> SymbolLocation
location

getEncoderName :: DatatypeStructure x -> Text
getEncoderName :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
getEncoderName = (.symbolName) (SymbolLocation -> ModuleName)
-> (DatatypeStructure x -> SymbolLocation)
-> DatatypeStructure x
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeStructure x -> SymbolLocation
forall {k} (x :: k). DatatypeStructure x -> SymbolLocation
getEncoderLocation

getEncoderModule :: DatatypeStructure x -> Text
getEncoderModule :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
getEncoderModule = (.symbolModuleName) (SymbolLocation -> ModuleName)
-> (DatatypeStructure x -> SymbolLocation)
-> DatatypeStructure x
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeStructure x -> SymbolLocation
forall {k} (x :: k). DatatypeStructure x -> SymbolLocation
getEncoderLocation

generateEncoder' :: DatatypeStructure x -> Text
generateEncoder' :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
generateEncoder' structure :: DatatypeStructure x
structure@(DatatypeStructure{Integer
[Constructor]
ElmMapping
$sel:mapping:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> ElmMapping
$sel:nParams:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> Integer
$sel:constructors:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> [Constructor]
mapping :: ElmMapping
nParams :: Integer
constructors :: [Constructor]
..})
    | ElmMapping
mapping.isTypeAlias =
        [trimming|
    $encoderName : $encoderType
    $defLineAlias
      $bodyAlias
  |]
    | Bool
otherwise =
        [trimming|
    $encoderName : $encoderType
    $defLine
      $body
  |]
  where
    encoderName :: ModuleName
encoderName = DatatypeStructure x
structure DatatypeStructure x
-> (DatatypeStructure x -> ModuleName) -> ModuleName
forall a b. a -> (a -> b) -> b
& DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
getEncoderName
    encoderType :: ModuleName
encoderType = DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderType DatatypeStructure x
structure
    defLine :: ModuleName
defLine = DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderDefLine DatatypeStructure x
structure
    defLineAlias :: ModuleName
defLineAlias = DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderDefLineAlias DatatypeStructure x
structure
    body :: ModuleName
body = DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderBody DatatypeStructure x
structure
    bodyAlias :: ModuleName
bodyAlias = DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderBodyAlias DatatypeStructure x
structure

mkEncoderType :: DatatypeStructure x -> Text
mkEncoderType :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderType DatatypeStructure x
structure =
    ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
        [[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat
            [ [ModuleName]
paramEncoderTypes
            , [DatatypeStructure x -> SymbolLocation -> ModuleName
forall {k} (x :: k).
DatatypeStructure x -> SymbolLocation -> ModuleName
qualifiedTypeNameAt DatatypeStructure x
structure (DatatypeStructure x
structure DatatypeStructure x
-> (DatatypeStructure x -> SymbolLocation) -> SymbolLocation
forall a b. a -> (a -> b) -> b
& DatatypeStructure x -> SymbolLocation
forall {k} (x :: k). DatatypeStructure x -> SymbolLocation
getEncoderLocation), ModuleName
"->", ModuleName
"Value"]
            ]
  where
    paramEncoderTypes :: [ModuleName]
paramEncoderTypes =
        ((\ModuleName
n -> ModuleName
"(e" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
n ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
" -> Value) ->") (ModuleName -> ModuleName)
-> (Integer -> ModuleName) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ModuleName
Text.pack ([Char] -> ModuleName)
-> (Integer -> [Char]) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show @Integer))
            (Integer -> ModuleName) -> [Integer] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DatatypeStructure x
structure.nParams) [Integer
0 ..]

mkEncoderDefLine :: DatatypeStructure x -> Text
mkEncoderDefLine :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderDefLine DatatypeStructure x
structure =
    ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
        [[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat
            [ [DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
getEncoderName DatatypeStructure x
structure]
            , ((ModuleName
"e" <>) (ModuleName -> ModuleName)
-> (Integer -> ModuleName) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ModuleName
Text.pack ([Char] -> ModuleName)
-> (Integer -> [Char]) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show @Integer) (Integer -> ModuleName) -> [Integer] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DatatypeStructure x
structure.nParams) [Integer
0 ..]
            , [ModuleName
"v", ModuleName
"="]
            ]

mkEncoderDefLineAlias :: DatatypeStructure x -> Text
mkEncoderDefLineAlias :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderDefLineAlias DatatypeStructure x
structure =
    ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
        [[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat
            [ [DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
getEncoderName DatatypeStructure x
structure]
            , ((ModuleName
"e" <>) (ModuleName -> ModuleName)
-> (Integer -> ModuleName) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ModuleName
Text.pack ([Char] -> ModuleName)
-> (Integer -> [Char]) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show @Integer) (Integer -> ModuleName) -> [Integer] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DatatypeStructure x
structure.nParams) [Integer
0 ..]
            , [ModuleName
"r", ModuleName
"="]
            ]

qualifiedTypeNameAt :: DatatypeStructure x -> SymbolLocation -> Text
qualifiedTypeNameAt :: forall {k} (x :: k).
DatatypeStructure x -> SymbolLocation -> ModuleName
qualifiedTypeNameAt s :: DatatypeStructure x
s@(DatatypeStructure{Integer
[Constructor]
ElmMapping
$sel:mapping:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> ElmMapping
$sel:nParams:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> Integer
$sel:constructors:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> [Constructor]
mapping :: ElmMapping
nParams :: Integer
constructors :: [Constructor]
..}) SymbolLocation
loc =
    let tName :: ModuleName
tName = case ElmMapping
mapping.moduleName of
            Maybe ModuleName
Nothing -> ElmMapping
mapping.typeName
            Just ModuleName
_ -> DatatypeStructure x -> SymbolLocation -> ModuleName
forall {k} (x :: k).
DatatypeStructure x -> SymbolLocation -> ModuleName
prefixFor DatatypeStructure x
s SymbolLocation
loc ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ElmMapping
mapping.typeName
        tArgs :: [ModuleName]
tArgs = ((ModuleName
"e" <>) (ModuleName -> ModuleName)
-> (Integer -> ModuleName) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ModuleName
Text.pack ([Char] -> ModuleName)
-> (Integer -> [Char]) -> Integer -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show @Integer) (Integer -> ModuleName) -> [Integer] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DatatypeStructure x
s.nParams) [Integer
0 ..]
        allComponents :: [ModuleName]
allComponents = ModuleName
tName ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: [ModuleName]
tArgs
     in case [ModuleName]
allComponents of
            [ModuleName
single] -> ModuleName
single
            [ModuleName]
_multiple -> ModuleName
"(" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " [ModuleName]
allComponents ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
")"

prefixFor :: DatatypeStructure x -> SymbolLocation -> Text
prefixFor :: forall {k} (x :: k).
DatatypeStructure x -> SymbolLocation -> ModuleName
prefixFor DatatypeStructure{Integer
[Constructor]
ElmMapping
$sel:mapping:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> ElmMapping
$sel:nParams:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> Integer
$sel:constructors:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> [Constructor]
mapping :: ElmMapping
nParams :: Integer
constructors :: [Constructor]
..} SymbolLocation
loc =
    case (ElmMapping
mapping.moduleName, SymbolLocation
loc.symbolModuleName) of
        (Maybe ModuleName
Nothing, ModuleName
_) -> ModuleName
""
        (Just ModuleName
m1, ModuleName
m2) -> if ModuleName
m1 ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m2 then ModuleName
"" else ModuleName
m1 ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
"."

mkEncoderBody :: DatatypeStructure x -> Text
mkEncoderBody :: forall {k} (x :: k). DatatypeStructure x -> ModuleName
mkEncoderBody structure :: DatatypeStructure x
structure@(DatatypeStructure{Integer
[Constructor]
ElmMapping
$sel:mapping:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> ElmMapping
$sel:nParams:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> Integer
$sel:constructors:DatatypeStructure :: forall {k} (a :: k). DatatypeStructure a -> [Constructor]
mapping :: ElmMapping
nParams :: Integer
constructors :: [Constructor]
..}) =
    [trimming|
    case v of
      $constructorBranches
  |]
  where
    constructorBranches :: ModuleName
constructorBranches = case [Constructor]
constructors of
        [] ->
            [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$
                [Char]
"Cannot generate encoder body (no constructors): "
                    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [Char]
forall a. Show a => a -> [Char]
show DatatypeStructure x
structure.mapping.typeName
        [Constructor
singleConstructor] ->
            DatatypeStructure x -> Constructor -> ModuleName
forall {k} (x :: k).
DatatypeStructure x -> Constructor -> ModuleName
unwrapConstructorBranch DatatypeStructure x
structure Constructor
singleConstructor
        [Constructor]
multiple ->
            DatatypeStructure x -> [Constructor] -> ModuleName
forall {k} (x :: k).
DatatypeStructure x -> [Constructor] -> ModuleName
multipleConstructorBranches DatatypeStructure x
structure [Constructor]
multiple

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

unwrapConstructorBranch :: DatatypeStructure x -> Constructor -> Text
unwrapConstructorBranch :: forall {k} (x :: k).
DatatypeStructure x -> Constructor -> ModuleName
unwrapConstructorBranch s :: DatatypeStructure x
s@(DatatypeStructure{}) Constructor
c =
    let (ModuleName
cName, [ModuleName]
cArgs, Maybe ModuleName
contentEncoder) = DatatypeStructure x
-> Constructor -> (ModuleName, [ModuleName], Maybe ModuleName)
forall {k} (x :: k).
DatatypeStructure x
-> Constructor -> (ModuleName, [ModuleName], Maybe ModuleName)
constructorBranchHelper DatatypeStructure x
s Constructor
c
        matchLine :: ModuleName
matchLine = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " (ModuleName
cName ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: [ModuleName]
cArgs)
     in (ModuleName -> ModuleName) -> Maybe ModuleName -> ModuleName
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
            ( \ModuleName
e ->
                [trimming|
                       $matchLine ->
                         $e
                       |]
            )
            Maybe ModuleName
contentEncoder

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

multipleConstructorBranches :: DatatypeStructure x -> [Constructor] -> Text
multipleConstructorBranches :: forall {k} (x :: k).
DatatypeStructure x -> [Constructor] -> ModuleName
multipleConstructorBranches DatatypeStructure x
structure [Constructor]
constructors =
    let prefix :: ModuleName
prefix = (DatatypeStructure x -> SymbolLocation -> ModuleName
forall {k} (x :: k).
DatatypeStructure x -> SymbolLocation -> ModuleName
prefixFor DatatypeStructure x
structure (DatatypeStructure x
structure DatatypeStructure x
-> (DatatypeStructure x -> SymbolLocation) -> SymbolLocation
forall a b. a -> (a -> b) -> b
& DatatypeStructure x -> SymbolLocation
forall {k} (x :: k). DatatypeStructure x -> SymbolLocation
getEncoderLocation))
     in (if (Constructor -> Bool) -> [Constructor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Constructor -> Bool
isNullary [Constructor]
constructors then ModuleName -> [ModuleName] -> ModuleName
encodeStringTags ModuleName
prefix ((.constructorName) (Constructor -> ModuleName) -> [Constructor] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constructor]
constructors) else DatatypeStructure x -> [Constructor] -> ModuleName
forall {k} (x :: k).
DatatypeStructure x -> [Constructor] -> ModuleName
encodeTaggedBranches DatatypeStructure x
structure [Constructor]
constructors)

encodeStringTags :: Text -> [ConstructorName] -> Text
encodeStringTags :: ModuleName -> [ModuleName] -> ModuleName
encodeStringTags ModuleName
prefix [ModuleName]
cnames =
    ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n" ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
        (\ModuleName
cname -> ModuleName
prefix ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
cname ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
" -> Json.Encode.string \"" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
cname ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
"\"") (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
cnames

encodeTaggedBranches :: DatatypeStructure x -> [Constructor] -> Text
encodeTaggedBranches :: forall {k} (x :: k).
DatatypeStructure x -> [Constructor] -> ModuleName
encodeTaggedBranches DatatypeStructure x
ds [Constructor]
cs = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n" ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ Constructor -> ModuleName
mkTagBranch (Constructor -> ModuleName) -> [Constructor] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constructor]
cs
  where
    mkTagBranch :: Constructor -> ModuleName
mkTagBranch Constructor
c =
        let (ModuleName
cName, [ModuleName]
cArgs, Maybe ModuleName
encodedContent) =
                DatatypeStructure x
-> Constructor -> (ModuleName, [ModuleName], Maybe ModuleName)
forall {k} (x :: k).
DatatypeStructure x
-> Constructor -> (ModuleName, [ModuleName], Maybe ModuleName)
constructorBranchHelper DatatypeStructure x
ds Constructor
c
            match :: ModuleName
match = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " (ModuleName
cName ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: [ModuleName]
cArgs)
            tag :: ModuleName
tag = Constructor
c.constructorName
            contentsField :: ModuleName
contentsField =
                (ModuleName -> ModuleName) -> Maybe ModuleName -> ModuleName
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                    ( \ModuleName
val ->
                        [untrimming|
                           , ( "contents"
                             , $val
                             )
                           |]
                    )
                    Maybe ModuleName
encodedContent
         in [trimming|
            $match -> Json.Encode.object
              [ ( "tag", Json.Encode.string "$tag" )$contentsField]
          |]

encoderForType :: DatatypeStructure x -> TyRef -> Text
encoderForType :: forall {k} (x :: k). DatatypeStructure x -> TyRef -> ModuleName
encoderForType DatatypeStructure x
ds TyRef{[TyRef]
TyCon
$sel:tyCon:TyRef :: TyRef -> TyCon
$sel:tyArgs:TyRef :: TyRef -> [TyRef]
tyCon :: TyCon
tyArgs :: [TyRef]
..} =
    case TyCon
tyCon of
        TyVar ModuleName
varName -> ModuleName
"e" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> HasCallStack => ModuleName -> ModuleName
ModuleName -> ModuleName
Text.tail ModuleName
varName -- Won't have args (No HKTs)
        TyMapping ElmMapping
mapping -> ElmMapping -> ModuleName
forall {a} {a} {r}.
(Show a, HasField "typeName" a a,
 HasField "encoderLocation" a (Maybe r), HasField "args" a [a],
 HasField "symbolName" r ModuleName,
 HasField "symbolModuleName" r ModuleName) =>
a -> ModuleName
renderMapping ElmMapping
mapping
  where
    renderMapping :: a -> ModuleName
renderMapping a
mapping =
        let encoderName :: ModuleName
encoderName = case a
mapping.encoderLocation of
                Maybe r
Nothing -> [Char] -> ModuleName
forall a. HasCallStack => [Char] -> a
error ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not find encoder for type: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
mapping.typeName
                Just r
location ->
                    (if r
location.symbolModuleName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== DatatypeStructure x -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> ModuleName
getEncoderModule DatatypeStructure x
ds then (r
location.symbolName) else r
location.symbolModuleName ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
"." ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> r
location.symbolName)
            paramEncoders :: [ModuleName]
paramEncoders =
                (a -> ModuleName
renderMapping (a -> ModuleName) -> [a] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
mapping.args)
                    [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> (DatatypeStructure x -> TyRef -> ModuleName
forall {k} (x :: k). DatatypeStructure x -> TyRef -> ModuleName
encoderForType DatatypeStructure x
ds (TyRef -> ModuleName) -> [TyRef] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyRef]
tyArgs)
         in ModuleName
"(" ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
" " (ModuleName
encoderName ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: [ModuleName]
paramEncoders) ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
")"

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

data ModuleDefinition = ModuleDefinition
    { ModuleDefinition -> Set ModuleName
imports :: Set ModuleName
    , ModuleDefinition -> [ModuleName]
typeDefs :: [Text]
    , ModuleDefinition -> [ModuleName]
encoders :: [Text]
    , ModuleDefinition -> [ModuleName]
decoders :: [Text]
    }
    deriving (ModuleDefinition -> ModuleDefinition -> Bool
(ModuleDefinition -> ModuleDefinition -> Bool)
-> (ModuleDefinition -> ModuleDefinition -> Bool)
-> Eq ModuleDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleDefinition -> ModuleDefinition -> Bool
== :: ModuleDefinition -> ModuleDefinition -> Bool
$c/= :: ModuleDefinition -> ModuleDefinition -> Bool
/= :: ModuleDefinition -> ModuleDefinition -> Bool
Eq, Int -> ModuleDefinition -> [Char] -> [Char]
[ModuleDefinition] -> [Char] -> [Char]
ModuleDefinition -> [Char]
(Int -> ModuleDefinition -> [Char] -> [Char])
-> (ModuleDefinition -> [Char])
-> ([ModuleDefinition] -> [Char] -> [Char])
-> Show ModuleDefinition
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ModuleDefinition -> [Char] -> [Char]
showsPrec :: Int -> ModuleDefinition -> [Char] -> [Char]
$cshow :: ModuleDefinition -> [Char]
show :: ModuleDefinition -> [Char]
$cshowList :: [ModuleDefinition] -> [Char] -> [Char]
showList :: [ModuleDefinition] -> [Char] -> [Char]
Show)

instance Semigroup ModuleDefinition where
    ModuleDefinition
m1 <> :: ModuleDefinition -> ModuleDefinition -> ModuleDefinition
<> ModuleDefinition
m2 =
        ModuleDefinition
            { imports :: Set ModuleName
imports = Set ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => Set a -> Set a -> Set a
Set.union ModuleDefinition
m1.imports ModuleDefinition
m2.imports
            , typeDefs :: [ModuleName]
typeDefs = ModuleDefinition
m1.typeDefs [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> ModuleDefinition
m2.typeDefs
            , encoders :: [ModuleName]
encoders = ModuleDefinition
m1.encoders [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> ModuleDefinition
m2.encoders
            , decoders :: [ModuleName]
decoders = ModuleDefinition
m1.decoders [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> ModuleDefinition
m2.decoders
            }
instance Monoid ModuleDefinition where
    mempty :: ModuleDefinition
mempty = Set ModuleName
-> [ModuleName] -> [ModuleName] -> [ModuleName] -> ModuleDefinition
ModuleDefinition Set ModuleName
forall a. Monoid a => a
mempty [ModuleName]
forall a. Monoid a => a
mempty [ModuleName]
forall a. Monoid a => a
mempty [ModuleName]
forall a. Monoid a => a
mempty

generateAll :: FilePath -> [SomeStructure] -> IO ()
generateAll :: [Char] -> [SomeStructure] -> IO ()
generateAll [Char]
baseDir [SomeStructure]
ds = do
    let srcMap :: Map ModuleName ModuleName
srcMap = [SomeStructure] -> Map ModuleName ModuleName
mkSourceMap [SomeStructure]
ds
    ((ModuleName, ModuleName) -> IO ())
-> [(ModuleName, ModuleName)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ([Char] -> (ModuleName, ModuleName) -> IO ()
outputModule [Char]
baseDir) ([(ModuleName, ModuleName)] -> IO ())
-> [(ModuleName, ModuleName)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map ModuleName ModuleName -> [(ModuleName, ModuleName)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map ModuleName ModuleName
srcMap

mkSourceMap :: [SomeStructure] -> Map ModuleName Text
mkSourceMap :: [SomeStructure] -> Map ModuleName ModuleName
mkSourceMap [SomeStructure]
ds = (ModuleName -> ModuleDefinition -> ModuleName)
-> Map ModuleName ModuleDefinition -> Map ModuleName ModuleName
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey ModuleName -> ModuleDefinition -> ModuleName
renderModule (Map ModuleName ModuleDefinition -> Map ModuleName ModuleName)
-> Map ModuleName ModuleDefinition -> Map ModuleName ModuleName
forall a b. (a -> b) -> a -> b
$ [SomeStructure] -> Map ModuleName ModuleDefinition
computeAll [SomeStructure]
ds

outputModule :: FilePath -> (ModuleName, Text) -> IO ()
outputModule :: [Char] -> (ModuleName, ModuleName) -> IO ()
outputModule [Char]
baseDir (ModuleName
mName, ModuleName
source) = do
    let fileDir :: [Char]
fileDir = [Char]
baseDir [Char] -> [Char] -> [Char]
</> [Char]
relDir
        filePath :: [Char]
filePath = [Char]
fileDir [Char] -> [Char] -> [Char]
</> [Char]
fileName
        fileName :: [Char]
fileName = [Char]
fileComponent [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".elm"
        relDir :: [Char]
relDir = ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Char] -> [Char] -> [Char]
(</>) [Char]
"" [[Char]]
dirComponents
        fileComponent :: [Char]
fileComponent = [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
reversed
        dirComponents :: [[Char]]
dirComponents = [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Char]]
reversed
        reversed :: [[Char]]
reversed = [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
moduleComponents
        moduleComponents :: [[Char]]
moduleComponents = ModuleName -> [Char]
Text.unpack (ModuleName -> [Char]) -> [ModuleName] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ModuleName -> [ModuleName]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') ModuleName
mName
    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
fileDir
    [Char] -> ModuleName -> IO ()
Text.writeFile [Char]
filePath ModuleName
source

renderModule :: ModuleName -> ModuleDefinition -> Text
renderModule :: ModuleName -> ModuleDefinition -> ModuleName
renderModule ModuleName
mName ModuleDefinition{[ModuleName]
Set ModuleName
imports :: ModuleDefinition -> Set ModuleName
typeDefs :: ModuleDefinition -> [ModuleName]
encoders :: ModuleDefinition -> [ModuleName]
decoders :: ModuleDefinition -> [ModuleName]
imports :: Set ModuleName
typeDefs :: [ModuleName]
encoders :: [ModuleName]
decoders :: [ModuleName]
..} =
    [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 :: ModuleName
typeDefsSrc = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n\n" [ModuleName]
typeDefs
    encodersSrc :: ModuleName
encodersSrc = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n\n" [ModuleName]
encoders
    decodersSrc :: ModuleName
decodersSrc = ModuleName -> [ModuleName] -> ModuleName
Text.intercalate ModuleName
"\n\n" [ModuleName]
decoders
    importsSrc :: ModuleName
importsSrc = [ModuleName] -> ModuleName
Text.unlines ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$ (ModuleName
"import " <>) (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
Set.toAscList Set ModuleName
imports)

computeAll :: [SomeStructure] -> Map ModuleName ModuleDefinition
computeAll :: [SomeStructure] -> Map ModuleName ModuleDefinition
computeAll = (Map ModuleName ModuleDefinition
 -> (ModuleName, ModuleDefinition)
 -> Map ModuleName ModuleDefinition)
-> Map ModuleName ModuleDefinition
-> [(ModuleName, ModuleDefinition)]
-> Map ModuleName ModuleDefinition
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map ModuleName ModuleDefinition
-> (ModuleName, ModuleDefinition)
-> Map ModuleName ModuleDefinition
forall {k} {a}.
(Ord k, Semigroup a) =>
Map k a -> (k, a) -> Map k a
addToModules Map ModuleName ModuleDefinition
forall k a. Map k a
Map.empty ([(ModuleName, ModuleDefinition)]
 -> Map ModuleName ModuleDefinition)
-> ([SomeStructure] -> [(ModuleName, ModuleDefinition)])
-> [SomeStructure]
-> Map ModuleName ModuleDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(ModuleName, ModuleDefinition)]]
-> [(ModuleName, ModuleDefinition)]
forall a. Monoid a => [a] -> a
mconcat ([[(ModuleName, ModuleDefinition)]]
 -> [(ModuleName, ModuleDefinition)])
-> ([SomeStructure] -> [[(ModuleName, ModuleDefinition)]])
-> [SomeStructure]
-> [(ModuleName, ModuleDefinition)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeStructure -> [(ModuleName, ModuleDefinition)])
-> [SomeStructure] -> [[(ModuleName, ModuleDefinition)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeStructure -> [(ModuleName, ModuleDefinition)]
mkModuleDefs
  where
    addToModules :: Map k a -> (k, a) -> Map k a
addToModules Map k a
modules (k
mName, a
def) =
        (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) k
mName a
def Map k a
modules
    mkModuleDefs :: SomeStructure -> [(ModuleName, ModuleDefinition)]
mkModuleDefs (SomeStructure DatatypeStructure x
ds) =
        let constructorImports :: Set ModuleName
constructorImports = [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName) -> [ModuleName] -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ [[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat ([[ModuleName]] -> [ModuleName]) -> [[ModuleName]] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Constructor -> [ModuleName]
getImports (Constructor -> [ModuleName]) -> [Constructor] -> [[ModuleName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatatypeStructure x
ds.constructors
            typeImport :: Set ModuleName
typeImport = [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName) -> [ModuleName] -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList DatatypeStructure x
ds.mapping.moduleName
         in [Maybe (ModuleName, ModuleDefinition)]
-> [(ModuleName, ModuleDefinition)]
forall a. [Maybe a] -> [a]
catMaybes
                [ case DatatypeStructure x
ds.mapping.moduleName of
                    Maybe ModuleName
Nothing -> Maybe (ModuleName, ModuleDefinition)
forall a. Maybe a
Nothing
                    Just ModuleName
mName -> (ModuleName, ModuleDefinition)
-> Maybe (ModuleName, ModuleDefinition)
forall a. a -> Maybe a
Just (ModuleName
mName, ModuleDefinition
mDef)
                      where
                        mDef :: ModuleDefinition
mDef =
                            ModuleDefinition
forall a. Monoid a => a
mempty
                                { imports = Set.delete mName constructorImports
                                , typeDefs = pure $ generateTypeDef' ds
                                }
                , case DatatypeStructure x
ds.mapping.encoderLocation of
                    Maybe SymbolLocation
Nothing -> Maybe (ModuleName, ModuleDefinition)
forall a. Maybe a
Nothing
                    Just SymbolLocation
encoder -> (ModuleName, ModuleDefinition)
-> Maybe (ModuleName, ModuleDefinition)
forall a. a -> Maybe a
Just (SymbolLocation
encoder.symbolModuleName, ModuleDefinition
mDef)
                      where
                        mDef :: ModuleDefinition
mDef =
                            ModuleDefinition
forall a. Monoid a => a
mempty
                                { imports =
                                    Set.delete
                                        encoder.symbolModuleName
                                        (constructorImports `Set.union` typeImport)
                                , encoders = pure $ generateEncoder' ds
                                }
                , case DatatypeStructure x
ds.mapping.decoderLocation of
                    Maybe SymbolLocation
Nothing -> Maybe (ModuleName, ModuleDefinition)
forall a. Maybe a
Nothing
                    Just SymbolLocation
decoder -> (ModuleName, ModuleDefinition)
-> Maybe (ModuleName, ModuleDefinition)
forall a. a -> Maybe a
Just (SymbolLocation
decoder.symbolModuleName, ModuleDefinition
mDef)
                      where
                        mDef :: ModuleDefinition
mDef =
                            ModuleDefinition
forall a. Monoid a => a
mempty
                                { imports =
                                    Set.delete
                                        decoder.symbolModuleName
                                        (constructorImports `Set.union` typeImport)
                                , decoders = pure $ generateDecoder' ds
                                }
                ]

getImports :: Constructor -> [Text]
getImports :: Constructor -> [ModuleName]
getImports Constructor{[ElmField]
ModuleName
$sel:constructorName:Constructor :: Constructor -> ModuleName
$sel:constructorFields:Constructor :: Constructor -> [ElmField]
constructorName :: ModuleName
constructorFields :: [ElmField]
..} = [[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat ([[ModuleName]] -> [ModuleName]) -> [[ModuleName]] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ ElmField -> [ModuleName]
forall {a}. (a, TyRef) -> [ModuleName]
getFieldImports (ElmField -> [ModuleName]) -> [ElmField] -> [[ModuleName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElmField]
constructorFields
  where
    getFieldImports :: (a, TyRef) -> [ModuleName]
getFieldImports (a
_, TyRef
tyRef) = TyRef -> [ModuleName]
getTypeImports TyRef
tyRef
    getTypeImports :: TyRef -> [Text]
    getTypeImports :: TyRef -> [ModuleName]
getTypeImports TyRef
tyRef =
        [[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat
            [ ([[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat ([[ModuleName]] -> [ModuleName]) -> [[ModuleName]] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ TyRef -> [ModuleName]
getTypeImports (TyRef -> [ModuleName]) -> [TyRef] -> [[ModuleName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyRef
tyRef.tyArgs)
            , TyCon -> [ModuleName]
mappingArgs TyRef
tyRef.tyCon
            ]
    mappingArgs :: TyCon -> [ModuleName]
mappingArgs TyCon
tyCon = case TyCon
tyCon of
        TyMapping ElmMapping
mapping ->
            Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ElmMapping
mapping.moduleName
                [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((.symbolModuleName) (SymbolLocation -> ModuleName)
-> Maybe SymbolLocation -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElmMapping
mapping.encoderLocation)
                [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((.symbolModuleName) (SymbolLocation -> ModuleName)
-> Maybe SymbolLocation -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElmMapping
mapping.decoderLocation)
                [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> [[ModuleName]] -> [ModuleName]
forall a. Monoid a => [a] -> a
mconcat (TyCon -> [ModuleName]
mappingArgs (TyCon -> [ModuleName])
-> (ElmMapping -> TyCon) -> ElmMapping -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElmMapping -> TyCon
TyMapping (ElmMapping -> [ModuleName]) -> [ElmMapping] -> [[ModuleName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElmMapping
mapping.args)
        TyCon
_ -> [ModuleName]
forall a. Monoid a => a
mempty

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

    allRendered :: [Text]
    allRendered :: [ModuleName]
allRendered =
        TyCon -> [ModuleName]
renderTyCon TyRef
tyRef.tyCon [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> (ModuleName -> TyRef -> ModuleName
renderTyRef ModuleName
currentModule (TyRef -> ModuleName) -> [TyRef] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyRef
tyRef.tyArgs)

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

    mkTyCon :: ElmMapping -> Text
    mkTyCon :: ElmMapping -> ModuleName
mkTyCon ElmMapping
mapping = case ElmMapping
mapping.moduleName of
        Maybe ModuleName
Nothing -> ElmMapping
mapping.typeName
        Just ModuleName
mName -> (if ModuleName
mName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
currentModule then (ElmMapping
mapping.typeName) else ModuleName
mName ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
"." ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ElmMapping
mapping.typeName)

    renderMapping :: ElmMapping -> [Text]
    renderMapping :: ElmMapping -> [ModuleName]
renderMapping ElmMapping
mapping =
        (ElmMapping -> ModuleName
mkTyCon ElmMapping
mapping)
            ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: (([ModuleName] -> ModuleName
wrapIfNeeded ([ModuleName] -> ModuleName)
-> (ElmMapping -> [ModuleName]) -> ElmMapping -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElmMapping -> [ModuleName]
renderMapping) (ElmMapping -> ModuleName) -> [ElmMapping] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElmMapping
mapping.args)