module Elm.Print.Types
( prettyShowDefinition
, elmRecordDoc
, elmTypeDoc
) where
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import Internal.Prettyprinter.Compat (Doc, align, colon, comma, dquotes, emptyDoc, equals, lbrace, line,
lparen, nest, parens, pipe, pretty, prettyList, rbrace, rparen,
sep, space, vsep, (<+>))
import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord (..),
ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), getConstructorNames,
isEnum)
import Elm.Print.Common (arrow, showDoc, typeWithVarsDoc, wrapParens)
import qualified Data.List.NonEmpty as NE
prettyShowDefinition :: ElmDefinition -> Text
prettyShowDefinition :: ElmDefinition -> Text
prettyShowDefinition = forall ann. Doc ann -> Text
showDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. ElmDefinition -> Doc ann
elmDoc
elmDoc :: ElmDefinition -> Doc ann
elmDoc :: forall ann. ElmDefinition -> Doc ann
elmDoc = \case
DefRecord ElmRecord
elmRecord -> forall ann. ElmRecord -> Doc ann
elmRecordDoc ElmRecord
elmRecord
DefType ElmType
elmType -> forall ann. ElmType -> Doc ann
elmTypeDoc ElmType
elmType
DefPrim ElmPrim
_ -> forall ann. Doc ann
emptyDoc
elmTypeRefDoc :: TypeRef -> Doc ann
elmTypeRefDoc :: forall ann. TypeRef -> Doc ann
elmTypeRefDoc = \case
RefPrim ElmPrim
elmPrim -> forall ann. ElmPrim -> Doc ann
elmPrimDoc ElmPrim
elmPrim
RefCustom (TypeName Text
typeName) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
typeName
elmPrimDoc :: ElmPrim -> Doc ann
elmPrimDoc :: forall ann. 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"
ElmPrim
ElmValue -> Doc ann
"Value"
ElmMaybe TypeRef
t -> Doc ann
"Maybe" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
t
ElmResult TypeRef
l TypeRef
r -> Doc ann
"Result" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
r
ElmPair TypeRef
a TypeRef
b -> forall ann. Doc ann
lparen forall a. Semigroup a => a -> a -> a
<> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
a forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
b forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rparen
ElmTriple TypeRef
a TypeRef
b TypeRef
c -> forall ann. Doc ann
lparen forall a. Semigroup a => a -> a -> a
<> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
a forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
b forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
c forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rparen
ElmList TypeRef
l -> Doc ann
"List" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeParenDoc TypeRef
l
ElmNonEmptyPair TypeRef
a -> forall ann. Doc ann
lparen forall a. Semigroup a => a -> a -> a
<> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
a forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"List" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
a forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rparen
elmTypeParenDoc :: TypeRef -> Doc ann
elmTypeParenDoc :: forall ann. TypeRef -> Doc ann
elmTypeParenDoc = forall ann. Doc ann -> Doc ann
wrapParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. TypeRef -> Doc ann
elmTypeRefDoc
elmRecordDoc :: ElmRecord -> Doc ann
elmRecordDoc :: forall ann. ElmRecord -> Doc ann
elmRecordDoc ElmRecord{Bool
NonEmpty ElmRecordField
Text
elmRecordIsNewtype :: ElmRecord -> Bool
elmRecordFields :: ElmRecord -> NonEmpty ElmRecordField
elmRecordName :: ElmRecord -> Text
elmRecordIsNewtype :: Bool
elmRecordFields :: NonEmpty ElmRecordField
elmRecordName :: Text
..} = forall ann. Int -> Doc ann -> Doc ann
nest Int
4 forall a b. (a -> b) -> a -> b
$
forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ (Doc ann
"type alias" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmRecordName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals)
forall a. a -> [a] -> [a]
: forall ann. NonEmpty ElmRecordField -> [Doc ann]
fieldsDoc NonEmpty ElmRecordField
elmRecordFields
where
fieldsDoc :: NonEmpty ElmRecordField -> [Doc ann]
fieldsDoc :: forall ann. NonEmpty ElmRecordField -> [Doc ann]
fieldsDoc (ElmRecordField
fstR :| [ElmRecordField]
rest) =
forall ann. Doc ann
lbrace forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ElmRecordField -> Doc ann
recordFieldDoc ElmRecordField
fstR
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. ElmRecordField -> Doc ann
recordFieldDoc) [ElmRecordField]
rest
forall a. [a] -> [a] -> [a]
++ [forall ann. Doc ann
rbrace]
recordFieldDoc :: ElmRecordField -> Doc ann
recordFieldDoc :: forall ann. ElmRecordField -> Doc ann
recordFieldDoc ElmRecordField{Text
TypeRef
elmRecordFieldName :: ElmRecordField -> Text
elmRecordFieldType :: ElmRecordField -> TypeRef
elmRecordFieldName :: Text
elmRecordFieldType :: TypeRef
..} =
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmRecordFieldName
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
elmRecordFieldType
elmTypeDoc :: ElmType -> Doc ann
elmTypeDoc :: forall ann. ElmType -> Doc ann
elmTypeDoc t :: ElmType
t@ElmType{Bool
[Text]
NonEmpty ElmConstructor
Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
..} =
forall ann. Int -> Doc ann -> Doc ann
nest Int
4 ( forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ (Doc ann
"type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
sepVars)
forall a. a -> [a] -> [a]
: forall ann. NonEmpty ElmConstructor -> [Doc ann]
constructorsDoc NonEmpty ElmConstructor
elmTypeConstructors
)
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
unFunc
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
enumFuncs
where
sepVars :: Doc ann
sepVars :: forall ann. Doc ann
sepVars = case [Text]
elmTypeVars of
[] -> forall ann. Doc ann
emptyDoc
[Text]
vars -> forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
sep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Text]
vars)
constructorsDoc :: NonEmpty ElmConstructor -> [Doc ann]
constructorsDoc :: forall ann. NonEmpty ElmConstructor -> [Doc ann]
constructorsDoc (ElmConstructor
fstC :| [ElmConstructor]
rest) =
forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ElmConstructor -> Doc ann
constructorDoc ElmConstructor
fstC
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((forall ann. Doc ann
pipe forall ann. Doc ann -> Doc ann -> Doc ann
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. ElmConstructor -> Doc ann
constructorDoc) [ElmConstructor]
rest
constructorDoc :: ElmConstructor -> Doc ann
constructorDoc :: forall ann. ElmConstructor -> Doc ann
constructorDoc ElmConstructor{[TypeRef]
Text
elmConstructorFields :: ElmConstructor -> [TypeRef]
elmConstructorName :: ElmConstructor -> Text
elmConstructorFields :: [TypeRef]
elmConstructorName :: Text
..} = forall ann. [Doc ann] -> Doc ann
sep forall a b. (a -> b) -> a -> b
$
forall a ann. Pretty a => a -> Doc ann
pretty Text
elmConstructorName forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall ann. TypeRef -> Doc ann
elmTypeParenDoc [TypeRef]
elmConstructorFields
unFunc :: Doc ann
unFunc :: forall ann. Doc ann
unFunc =
if Bool
elmTypeIsNewtype
then forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. ElmType -> Doc ann
elmUnFuncDoc ElmType
t
else forall ann. Doc ann
emptyDoc
enumFuncs :: Doc ann
enumFuncs :: forall ann. Doc ann
enumFuncs =
if ElmType -> Bool
isEnum ElmType
t
then forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<>) [forall ann. ElmType -> Doc ann
elmEnumShowDoc ElmType
t, forall ann. ElmType -> Doc ann
elmEnumReadDoc ElmType
t, forall ann. ElmType -> Doc ann
elmEnumUniverse ElmType
t]
else forall ann. Doc ann
emptyDoc
elmUnFuncDoc :: ElmType -> Doc ann
elmUnFuncDoc :: forall ann. ElmType -> Doc ann
elmUnFuncDoc ElmType{Bool
[Text]
NonEmpty ElmConstructor
Text
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} = forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
vsep
[ forall ann. Doc ann
unName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Bool -> Text -> [Text] -> Doc ann
typeWithVarsDoc Bool
False Text
elmTypeName [Text]
elmTypeVars forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
arrow forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
result
, forall ann. Doc ann
unName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall ann. Doc ann
ctorName forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x") forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x"
]
where
unName :: Doc ann
unName :: forall ann. Doc ann
unName = Doc ann
"un" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName
ctor :: ElmConstructor
ctor :: ElmConstructor
ctor = forall a. NonEmpty a -> a
NE.head NonEmpty ElmConstructor
elmTypeConstructors
result :: Doc ann
result :: forall ann. Doc ann
result = case ElmConstructor -> [TypeRef]
elmConstructorFields ElmConstructor
ctor of
[] -> Doc ann
"ERROR"
TypeRef
fld : [TypeRef]
_ -> forall ann. TypeRef -> Doc ann
elmTypeRefDoc TypeRef
fld
ctorName :: Doc ann
ctorName :: forall ann. Doc ann
ctorName = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ ElmConstructor -> Text
elmConstructorName ElmConstructor
ctor
elmEnumShowDoc :: forall ann . ElmType -> Doc ann
t :: ElmType
t@ElmType{Bool
[Text]
NonEmpty ElmConstructor
Text
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} =
forall ann. Doc ann
line
forall a. Semigroup a => a -> a -> a
<> (Doc ann
showName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
arrow forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"String")
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
nest Int
4
( forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ (Doc ann
showName forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"case x of")
forall a. a -> [a] -> [a]
: 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" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName
patternMatch :: Text -> Doc ann
patternMatch :: Text -> Doc ann
patternMatch (forall a ann. Pretty a => a -> Doc ann
pretty -> Doc ann
c) = Doc ann
c forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
arrow forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes Doc ann
c
elmEnumReadDoc :: ElmType -> Doc ann
t :: ElmType
t@ElmType{Bool
[Text]
NonEmpty ElmConstructor
Text
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} =
(forall ann. Doc ann
readName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"String" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
arrow forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Maybe" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName)
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
nest Int
4
( forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ (forall ann. Doc ann
readName forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"x" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"case x of")
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall ann. Text -> Doc ann
patternMatch (ElmType -> [Text]
getConstructorNames ElmType
t)
forall a. [a] -> [a] -> [a]
++ [Doc ann
"_" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
arrow forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Nothing"]
)
where
readName :: Doc ann
readName :: forall ann. Doc ann
readName = Doc ann
"read" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName
patternMatch :: Text -> Doc ann
patternMatch :: forall ann. Text -> Doc ann
patternMatch (forall a ann. Pretty a => a -> Doc ann
pretty -> Doc ann
c) = forall ann. Doc ann -> Doc ann
dquotes Doc ann
c forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
arrow forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Just" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
c
elmEnumUniverse :: ElmType -> Doc ann
t :: ElmType
t@ElmType{Bool
[Text]
NonEmpty ElmConstructor
Text
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} = forall ann. [Doc ann] -> Doc ann
vsep
[ forall ann. Doc ann
universeName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"List" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName
, forall ann. Doc ann
universeName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => [a] -> Doc ann
prettyList forall a b. (a -> b) -> a -> b
$ ElmType -> [Text]
getConstructorNames ElmType
t)
]
where
universeName :: Doc ann
universeName :: forall ann. Doc ann
universeName = Doc ann
"universe" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName