{- | Pretty functions for `Types.elm` module.

The generated module should contain:

  * Type definitions for all ADT
  * @show*@ functions for Enum types
  * @read*@ functions for Enum types
  * @universe*@ functions for Enum types
  * @un*@ functions for newtypes

==== __Example__

The example of Record, Newtype and Enum generated type and functions:

@
type alias User =
    { id : Id
    , name : String
    , age : Age
    , status : RequestStatus
    }

type RequestStatus
    = Approved
    | Rejected
    | Reviewing

showRequestStatus : RequestStatus -> String
showRequestStatus x = case x of
    Approved -> \"Approved\"
    Rejected -> \"Rejected\"
    Reviewing -> \"Reviewing\"

readRequestStatus : String -> Maybe RequestStatus
readRequestStatus x = case x of
    \"Approved\" -> Just Approved
    \"Rejected\" -> Just Rejected
    \"Reviewing\" -> Just Reviewing
    _ -> Nothing

universeRequestStatus : List RequestStatus
universeRequestStatus = [Approved, Rejected, Reviewing]

type Id
    = Id String

unId : Id -> String
unId (Id x) = x
@

-}

module Elm.Print.Types
       ( prettyShowDefinition

         -- * Internal functions
       , elmAliasDoc
       , elmTypeDoc
       ) where

import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Doc, align, colon, comma, dquotes, emptyDoc, equals, lbrace, line,
                                  lparen, nest, parens, pipe, pretty, prettyList, rbrace, rparen,
                                  sep, space, vsep, (<+>))

import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..),
                ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), getConstructorNames,
                isEnum)
import Elm.Print.Common (arrow, showDoc, typeWithVarsDoc, wrapParens)

import qualified Data.List.NonEmpty as NE


{- | Pretty shows Elm types.

* See 'elmAliasDoc' for examples of generated @type alias@.
* See 'elmTypeDoc' for examples of generated @type@.
-}
prettyShowDefinition :: ElmDefinition -> Text
prettyShowDefinition :: ElmDefinition -> Text
prettyShowDefinition = Doc Any -> Text
forall ann. Doc ann -> Text
showDoc (Doc Any -> Text)
-> (ElmDefinition -> Doc Any) -> ElmDefinition -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElmDefinition -> Doc Any
forall ann. ElmDefinition -> Doc ann
elmDoc

elmDoc :: ElmDefinition -> Doc ann
elmDoc :: ElmDefinition -> Doc ann
elmDoc = \case
    DefAlias ElmAlias
elmAlias -> ElmAlias -> Doc ann
forall ann. ElmAlias -> Doc ann
elmAliasDoc ElmAlias
elmAlias
    DefType ElmType
elmType -> ElmType -> Doc ann
forall ann. ElmType -> Doc ann
elmTypeDoc ElmType
elmType
    DefPrim ElmPrim
_ -> Doc ann
forall ann. Doc ann
emptyDoc

-- | Pretty printer for type reference.
elmTypeRefDoc :: TypeRef -> Doc ann
elmTypeRefDoc :: TypeRef -> Doc ann
elmTypeRefDoc = \case
    RefPrim ElmPrim
elmPrim -> ElmPrim -> Doc ann
forall ann. ElmPrim -> Doc ann
elmPrimDoc ElmPrim
elmPrim
    RefCustom (TypeName Text
typeName) -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
typeName

{- | Pretty printer for primitive Elm types. This pretty printer is used only to
display types of fields.
-}
elmPrimDoc :: ElmPrim -> Doc ann
elmPrimDoc :: ElmPrim -> Doc ann
elmPrimDoc = \case
    ElmPrim
ElmUnit         -> Doc ann
"()"
    ElmPrim
ElmNever        -> Doc ann
"Never"
    ElmPrim
ElmBool         -> Doc ann
"Bool"
    ElmPrim
ElmChar         -> Doc ann
"Char"
    ElmPrim
ElmInt          -> Doc ann
"Int"
    ElmPrim
ElmFloat        -> Doc ann
"Float"
    ElmPrim
ElmString       -> Doc ann
"String"
    ElmPrim
ElmTime         -> Doc ann
"Posix"
    ElmMaybe TypeRef
t      -> Doc ann
"Maybe" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
t
    ElmResult TypeRef
l TypeRef
r   -> Doc ann
"Result" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
l Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
r
    ElmPair TypeRef
a TypeRef
b     -> Doc ann
forall ann. Doc ann
lparen Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
b Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rparen
    ElmTriple TypeRef
a TypeRef
b TypeRef
c -> Doc ann
forall ann. Doc ann
lparen Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
b Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
c Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rparen
    ElmList TypeRef
l       -> Doc ann
"List" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
l

{- | Pretty-printer for types. Adds parens for both sides when needed (when type
contains of multiple words).
-}
elmTypeParenDoc :: TypeRef -> Doc ann
elmTypeParenDoc :: TypeRef -> Doc ann
elmTypeParenDoc = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
wrapParens (Doc ann -> Doc ann) -> (TypeRef -> Doc ann) -> TypeRef -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc

{- | Pretty printer for Elm aliases:

@
type alias User =
    { userHeh : String
    , userMeh : Int
    }
@
-}
elmAliasDoc :: ElmAlias -> Doc ann
elmAliasDoc :: ElmAlias -> Doc ann
elmAliasDoc ElmAlias{Bool
Text
NonEmpty ElmRecordField
elmAliasIsNewtype :: ElmAlias -> Bool
elmAliasFields :: ElmAlias -> NonEmpty ElmRecordField
elmAliasName :: ElmAlias -> Text
elmAliasIsNewtype :: Bool
elmAliasFields :: NonEmpty ElmRecordField
elmAliasName :: Text
..} = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
4 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann
"type alias" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmAliasName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals)
         Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: NonEmpty ElmRecordField -> [Doc ann]
forall ann. NonEmpty ElmRecordField -> [Doc ann]
fieldsDoc NonEmpty ElmRecordField
elmAliasFields
  where
    fieldsDoc :: NonEmpty ElmRecordField -> [Doc ann]
    fieldsDoc :: NonEmpty ElmRecordField -> [Doc ann]
fieldsDoc (ElmRecordField
fstR :| [ElmRecordField]
rest) =
        Doc ann
forall ann. Doc ann
lbrace Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ElmRecordField -> Doc ann
forall ann. ElmRecordField -> Doc ann
recordFieldDoc ElmRecordField
fstR
      Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (ElmRecordField -> Doc ann) -> [ElmRecordField] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc ann -> Doc ann)
-> (ElmRecordField -> Doc ann) -> ElmRecordField -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElmRecordField -> Doc ann
forall ann. ElmRecordField -> Doc ann
recordFieldDoc) [ElmRecordField]
rest
     [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann
forall ann. Doc ann
rbrace]

    recordFieldDoc :: ElmRecordField -> Doc ann
    recordFieldDoc :: ElmRecordField -> Doc ann
recordFieldDoc ElmRecordField{Text
TypeRef
elmRecordFieldName :: ElmRecordField -> Text
elmRecordFieldType :: ElmRecordField -> TypeRef
elmRecordFieldName :: Text
elmRecordFieldType :: TypeRef
..} =
            Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmRecordFieldName
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
elmRecordFieldType

{- | Pretty printer for Elm types with one or more constructors:

@
type Status a
    = Foo String Int
    | Bar a
    | Baz
@

If the type is a newtype then additionally @unTYPENAME@ function is generated:

@
type Id a
    = Id String

unId : Id a -> String
unId (Id x) = x
@

If the type is Enum this function will add enum specific functions:

@
type Status
    = Approved
    | Yoyoyo
    | Wow

showStatus : Status -> String
showStatus x = case x of
    Approved -> \"Approved\"
    Yoyoyo -> \"Yoyoyo\"
    Wow -> \"Wow\"

readStatus : String -> Maybe Status
readStatus x = case x of
    \"Approved\" -> Just Approved
    \"Yoyoyo\" -> Just Yoyoyo
    \"Wow\" -> Just Wow
    _ -> Nothing

universeStatus : List Status
universeStatus = [Approved, Yoyoyo, Wow]
@
-}
elmTypeDoc :: ElmType -> Doc ann
elmTypeDoc :: ElmType -> Doc ann
elmTypeDoc t :: ElmType
t@ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
..} =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
4 ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann
"type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
sepVars)
                  Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: NonEmpty ElmConstructor -> [Doc ann]
forall ann. NonEmpty ElmConstructor -> [Doc ann]
constructorsDoc NonEmpty ElmConstructor
elmTypeConstructors
           )
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
unFunc
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
enumFuncs
  where
    sepVars :: Doc ann
    sepVars :: Doc ann
sepVars = case [Text]
elmTypeVars of
        []   -> Doc ann
forall ann. Doc ann
emptyDoc
        [Text]
vars -> Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Text]
vars)

    constructorsDoc :: NonEmpty ElmConstructor -> [Doc ann]
    constructorsDoc :: NonEmpty ElmConstructor -> [Doc ann]
constructorsDoc (ElmConstructor
fstC :| [ElmConstructor]
rest) =
        Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ElmConstructor -> Doc ann
forall ann. ElmConstructor -> Doc ann
constructorDoc ElmConstructor
fstC
        Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (ElmConstructor -> Doc ann) -> [ElmConstructor] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc ann -> Doc ann)
-> (ElmConstructor -> Doc ann) -> ElmConstructor -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElmConstructor -> Doc ann
forall ann. ElmConstructor -> Doc ann
constructorDoc) [ElmConstructor]
rest

    constructorDoc :: ElmConstructor -> Doc ann
    constructorDoc :: ElmConstructor -> Doc ann
constructorDoc ElmConstructor{[TypeRef]
Text
elmConstructorFields :: ElmConstructor -> [TypeRef]
elmConstructorName :: ElmConstructor -> Text
elmConstructorFields :: [TypeRef]
elmConstructorName :: Text
..} = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmConstructorName Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeRef -> Doc ann) -> [TypeRef] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
wrapParens (Doc ann -> Doc ann) -> (TypeRef -> Doc ann) -> TypeRef -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc) [TypeRef]
elmConstructorFields

    -- Generates 'unTYPENAME' function for newtype
    unFunc :: Doc ann
    unFunc :: Doc ann
unFunc =
        if Bool
elmTypeIsNewtype
        then Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ElmType -> Doc ann
forall ann. ElmType -> Doc ann
elmUnFuncDoc ElmType
t
        else Doc ann
forall ann. Doc ann
emptyDoc

    enumFuncs :: Doc ann
    enumFuncs :: Doc ann
enumFuncs =
        if ElmType -> Bool
isEnum ElmType
t
        then [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann -> Doc ann) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) [ElmType -> Doc ann
forall ann. ElmType -> Doc ann
elmEnumShowDoc ElmType
t, ElmType -> Doc ann
forall ann. ElmType -> Doc ann
elmEnumReadDoc ElmType
t, ElmType -> Doc ann
forall ann. ElmType -> Doc ann
elmEnumUniverse ElmType
t]
        else Doc ann
forall ann. Doc ann
emptyDoc

elmUnFuncDoc :: ElmType -> Doc ann
elmUnFuncDoc :: ElmType -> Doc ann
elmUnFuncDoc ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} = Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
    [ Doc ann
forall ann. Doc ann
unName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Text -> [Text] -> Doc ann
forall ann. Bool -> Text -> [Text] -> Doc ann
typeWithVarsDoc Bool
False Text
elmTypeName [Text]
elmTypeVars Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
arrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
result
    , Doc ann
forall ann. Doc ann
unName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann
forall ann. Doc ann
ctorName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x"
    ]
  where
    unName :: Doc ann
    unName :: Doc ann
unName = Doc ann
"un" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName

    ctor :: ElmConstructor
    ctor :: ElmConstructor
ctor = NonEmpty ElmConstructor -> ElmConstructor
forall a. NonEmpty a -> a
NE.head NonEmpty ElmConstructor
elmTypeConstructors

    result :: Doc ann
    result :: Doc ann
result = case ElmConstructor -> [TypeRef]
elmConstructorFields ElmConstructor
ctor of
        []      -> Doc ann
"ERROR"
        TypeRef
fld : [TypeRef]
_ -> TypeRef -> Doc ann
forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
fld

    ctorName :: Doc ann
    ctorName :: Doc ann
ctorName = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ ElmConstructor -> Text
elmConstructorName ElmConstructor
ctor

elmEnumShowDoc :: forall ann . ElmType -> Doc ann
elmEnumShowDoc :: ElmType -> Doc ann
elmEnumShowDoc t :: ElmType
t@ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} =
    Doc ann
forall ann. Doc ann
line
    -- function type
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Doc ann
showName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
arrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"String")
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line
    -- function body
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
4
        ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann
showName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"case x of")
        -- pattern matching
        Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
patternMatch (ElmType -> [Text]
getConstructorNames ElmType
t)
        )
  where
    showName :: Doc ann
    showName :: Doc ann
showName = Doc ann
"show" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName

    patternMatch :: Text -> Doc ann
    patternMatch :: Text -> Doc ann
patternMatch (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty -> Doc ann
c) = Doc ann
c Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
arrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes Doc ann
c

elmEnumReadDoc :: ElmType -> Doc ann
elmEnumReadDoc :: ElmType -> Doc ann
elmEnumReadDoc t :: ElmType
t@ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} =
    -- function type
    (Doc ann
forall ann. Doc ann
readName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"String" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
arrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Maybe" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName)
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line
    -- function body
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
4
        ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann
forall ann. Doc ann
readName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"case x of")
        -- pattern matching
        Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
patternMatch (ElmType -> [Text]
getConstructorNames ElmType
t)
       [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann
"_" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
arrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Nothing"]
        )
  where
    readName :: Doc ann
    readName :: Doc ann
readName = Doc ann
"read" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName

    patternMatch :: Text -> Doc ann
    patternMatch :: Text -> Doc ann
patternMatch (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty -> Doc ann
c) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes Doc ann
c Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
arrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Just" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
c

elmEnumUniverse :: ElmType -> Doc ann
elmEnumUniverse :: ElmType -> Doc ann
elmEnumUniverse t :: ElmType
t@ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
    -- function type
    [ Doc ann
forall ann. Doc ann
universeName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"List" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName
    , Doc ann
forall ann. Doc ann
universeName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Text] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyList ([Text] -> Doc ann) -> [Text] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ElmType -> [Text]
getConstructorNames ElmType
t)
    ]
  where
    universeName :: Doc ann
    universeName :: Doc ann
universeName = Doc ann
"universe" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName