module Elm.Print.Decoder
( prettyShowDecoder
, decodeEnum
, decodeChar
, decodeEither
, decodePair
, decodeTriple
, decodeNonEmpty
) where
import Data.List.NonEmpty (toList)
import Data.Text (Text)
import Internal.Prettyprinter.Compat (Doc, colon, concatWith, dquotes, emptyDoc, equals, line, nest,
parens, pretty, surround, vsep, (<+>))
import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord (..),
ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), isEnum)
import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc, wrapParens)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
prettyShowDecoder :: ElmDefinition -> Text
prettyShowDecoder :: ElmDefinition -> Text
prettyShowDecoder ElmDefinition
def = forall ann. Doc ann -> Text
showDoc forall a b. (a -> b) -> a -> b
$ case ElmDefinition
def of
DefRecord ElmRecord
elmRecord -> forall ann. ElmRecord -> Doc ann
recordDecoderDoc ElmRecord
elmRecord
DefType ElmType
elmType -> forall ann. ElmType -> Doc ann
typeDecoderDoc ElmType
elmType
DefPrim ElmPrim
_ -> forall ann. Doc ann
emptyDoc
recordDecoderDoc :: ElmRecord -> Doc ann
recordDecoderDoc :: forall ann. ElmRecord -> Doc ann
recordDecoderDoc ElmRecord{Bool
NonEmpty ElmRecordField
Text
elmRecordIsNewtype :: ElmRecord -> Bool
elmRecordFields :: ElmRecord -> NonEmpty ElmRecordField
elmRecordName :: ElmRecord -> Text
elmRecordIsNewtype :: Bool
elmRecordFields :: NonEmpty ElmRecordField
elmRecordName :: Text
..} =
forall ann. Text -> [Text] -> Doc ann
decoderDef Text
elmRecordName []
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
forall a. Semigroup a => a -> a -> a
<> if Bool
elmRecordIsNewtype
then forall ann. Doc ann
newtypeDecoder
else forall ann. Doc ann
recordDecoder
where
newtypeDecoder :: Doc ann
newtypeDecoder :: forall ann. Doc ann
newtypeDecoder = forall ann. Doc ann
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"D.map" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
qualifiedRecordName
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder forall a b. (a -> b) -> a -> b
$ ElmRecordField -> TypeRef
elmRecordFieldType forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head NonEmpty ElmRecordField
elmRecordFields)
recordDecoder :: Doc ann
recordDecoder :: forall ann. Doc ann
recordDecoder = 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
$ (forall ann. Doc ann
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"D.succeed" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
qualifiedRecordName)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall ann. ElmRecordField -> Doc ann
fieldDecode (forall a. NonEmpty a -> [a]
toList NonEmpty ElmRecordField
elmRecordFields)
name :: Doc ann
name :: forall ann. Doc ann
name = forall ann. Text -> Doc ann
decoderName Text
elmRecordName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
qualifiedRecordName :: Doc ann
qualifiedRecordName :: forall ann. Doc ann
qualifiedRecordName = forall ann. Text -> Doc ann
mkQualified Text
elmRecordName
fieldDecode :: ElmRecordField -> Doc ann
fieldDecode :: forall ann. ElmRecordField -> Doc ann
fieldDecode ElmRecordField{Text
TypeRef
elmRecordFieldName :: ElmRecordField -> Text
elmRecordFieldName :: Text
elmRecordFieldType :: TypeRef
elmRecordFieldType :: ElmRecordField -> TypeRef
..} = case TypeRef
elmRecordFieldType of
RefPrim ElmPrim
ElmUnit -> Doc ann
"|> D.hardcoded ()"
TypeRef
t -> Doc ann
"|> required"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty Text
elmRecordFieldName)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
t)
typeDecoderDoc :: ElmType -> Doc ann
typeDecoderDoc :: forall ann. ElmType -> Doc ann
typeDecoderDoc 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. Text -> [Text] -> Doc ann
decoderDef Text
elmTypeName [Text]
elmTypeVars
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
forall a. Semigroup a => a -> a -> a
<> if ElmType -> Bool
isEnum ElmType
t
then forall ann. Doc ann
enumDecoder
else if Bool
elmTypeIsNewtype
then forall ann. Doc ann
newtypeDecoder
else forall ann. Doc ann
sumDecoder
where
name :: Doc ann
name :: forall ann. Doc ann
name = forall ann. Text -> Doc ann
decoderName Text
elmTypeName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
typeName :: Doc ann
typeName :: forall ann. Doc ann
typeName = forall a ann. Pretty a => a -> Doc ann
pretty Text
elmTypeName
qualifiedTypeName :: Doc ann
qualifiedTypeName :: forall ann. Doc ann
qualifiedTypeName = forall ann. Text -> Doc ann
mkQualified Text
elmTypeName
enumDecoder :: Doc ann
enumDecoder :: forall ann. Doc ann
enumDecoder = forall ann. Doc ann
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"elmStreetDecodeEnum T.read" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
typeName
newtypeDecoder :: Doc ann
newtypeDecoder :: forall ann. Doc ann
newtypeDecoder = forall ann. Doc ann
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"D.map" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
qualifiedTypeName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
fieldDecoderDoc
where
fieldDecoderDoc :: Doc ann
fieldDecoderDoc :: forall ann. Doc ann
fieldDecoderDoc = case ElmConstructor -> [TypeRef]
elmConstructorFields forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head NonEmpty ElmConstructor
elmTypeConstructors of
[] -> Doc ann
"(D.fail \"Unknown field type of the newtype constructor\")"
TypeRef
f : [TypeRef]
_ -> forall ann. Doc ann -> Doc ann
wrapParens forall a b. (a -> b) -> a -> b
$ forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
f
sumDecoder :: Doc ann
sumDecoder :: forall ann. Doc ann
sumDecoder = 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 ann. Doc ann
name
, 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
"let decide : String -> Decoder" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
qualifiedTypeName) forall 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
"decide x = case x of"
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall ann. ElmConstructor -> Doc ann
cases (forall a. NonEmpty a -> [a]
toList NonEmpty ElmConstructor
elmTypeConstructors)
forall a. [a] -> [a] -> [a]
++ [Doc ann
"c -> D.fail <|" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall ann. Doc ann
typeName forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"doesn't have such constructor: ") forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"++ c"]
)
])
, Doc ann
"in D.andThen decide (D.field \"tag\" D.string)"
]
cases :: ElmConstructor -> Doc ann
cases :: forall ann. ElmConstructor -> Doc ann
cases ElmConstructor{[TypeRef]
Text
elmConstructorName :: ElmConstructor -> Text
elmConstructorFields :: [TypeRef]
elmConstructorName :: Text
elmConstructorFields :: ElmConstructor -> [TypeRef]
..} = forall ann. Doc ann -> Doc ann
dquotes forall ann. Doc ann
cName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
arrow forall ann. Doc ann -> Doc ann -> Doc ann
<+>
case [TypeRef]
elmConstructorFields of
[] -> Doc ann
"D.succeed" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
qualifiedConName
[TypeRef
f] -> Doc ann
"D.field \"contents\" <| D.map" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
qualifiedConName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
f)
[TypeRef]
l -> Doc ann
"D.field \"contents\" <| D.map" forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann
mapNum (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeRef]
l) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
qualifiedConName forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
createIndexes
where
cName :: Doc ann
cName :: forall ann. Doc ann
cName = forall a ann. Pretty a => a -> Doc ann
pretty Text
elmConstructorName
qualifiedConName :: Doc ann
qualifiedConName :: forall ann. Doc ann
qualifiedConName = forall ann. Text -> Doc ann
mkQualified Text
elmConstructorName
mapNum :: Int -> Doc ann
mapNum :: forall ann. Int -> Doc ann
mapNum Int
1 = forall ann. Doc ann
emptyDoc
mapNum Int
i = forall a ann. Pretty a => a -> Doc ann
pretty Int
i
createIndexes :: Doc ann
createIndexes :: forall ann. Doc ann
createIndexes = forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
surround Doc ann
" ") forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall ann. Int -> TypeRef -> Doc ann
oneField [Int
0..] [TypeRef]
elmConstructorFields
oneField :: Int -> TypeRef -> Doc ann
oneField :: forall ann. Int -> TypeRef -> Doc ann
oneField Int
i TypeRef
typeRef = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ Doc ann
"D.index"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
i
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
typeRef)
typeRefDecoder :: TypeRef -> Doc ann
typeRefDecoder :: forall ann. TypeRef -> Doc ann
typeRefDecoder (RefCustom TypeName{Text
unTypeName :: TypeName -> Text
unTypeName :: Text
..}) = Doc ann
"decode" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ((Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
' ') Text
unTypeName)
typeRefDecoder (RefPrim ElmPrim
elmPrim) = case ElmPrim
elmPrim of
ElmPrim
ElmUnit -> Doc ann
"D.map (always ()) (D.list D.string)"
ElmPrim
ElmNever -> Doc ann
"D.fail \"Never is not possible\""
ElmPrim
ElmBool -> Doc ann
"D.bool"
ElmPrim
ElmChar -> Doc ann
"elmStreetDecodeChar"
ElmPrim
ElmInt -> Doc ann
"D.int"
ElmPrim
ElmFloat -> Doc ann
"D.float"
ElmPrim
ElmString -> Doc ann
"D.string"
ElmPrim
ElmTime -> Doc ann
"Iso.decoder"
ElmPrim
ElmValue -> Doc ann
"D.value"
ElmMaybe TypeRef
t -> Doc ann
"nullable"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
t)
ElmResult TypeRef
l TypeRef
r -> Doc ann
"elmStreetDecodeEither"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
l)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
r)
ElmPair TypeRef
a TypeRef
b -> Doc ann
"elmStreetDecodePair"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
a)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
b)
ElmTriple TypeRef
a TypeRef
b TypeRef
c -> Doc ann
"elmStreetDecodeTriple"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
a)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
b)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
c)
ElmList TypeRef
l -> Doc ann
"D.list" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
l)
ElmNonEmptyPair TypeRef
a -> Doc ann
"elmStreetDecodeNonEmpty" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. TypeRef -> Doc ann
typeRefDecoder TypeRef
a)
decoderDef
:: Text
-> [Text]
-> Doc ann
decoderDef :: forall ann. Text -> [Text] -> Doc ann
decoderDef Text
typeName [Text]
vars =
forall ann. Text -> Doc ann
decoderName Text
typeName
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Decoder"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
wrapParens (forall ann. Text -> [Text] -> Doc ann
qualifiedTypeWithVarsDoc Text
typeName [Text]
vars)
decoderName :: Text -> Doc ann
decoderName :: forall ann. Text -> Doc ann
decoderName Text
typeName = Doc ann
"decode" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
typeName
decodeEnum :: Text
decodeEnum :: Text
decodeEnum = [Text] -> Text
T.unlines
[ Text
"decodeStr : (String -> Maybe a) -> String -> Decoder a"
, Text
"decodeStr readX x = case readX x of"
, Text
" Just a -> D.succeed a"
, Text
" Nothing -> D.fail \"Constructor not matched\""
, Text
""
, Text
"elmStreetDecodeEnum : (String -> Maybe a) -> Decoder a"
, Text
"elmStreetDecodeEnum r = D.andThen (decodeStr r) D.string"
]
decodeChar :: Text
decodeChar :: Text
decodeChar = [Text] -> Text
T.unlines
[ Text
"elmStreetDecodeChar : Decoder Char"
, Text
"elmStreetDecodeChar = D.andThen (decodeStr (Maybe.map Tuple.first << String.uncons)) D.string"
]
decodeEither :: Text
decodeEither :: Text
decodeEither = [Text] -> Text
T.unlines
[ Text
"elmStreetDecodeEither : Decoder a -> Decoder b -> Decoder (Result a b)"
, Text
"elmStreetDecodeEither decA decB = D.oneOf "
, Text
" [ D.field \"Left\" (D.map Err decA)"
, Text
" , D.field \"Right\" (D.map Ok decB)"
, Text
" ]"
]
decodePair :: Text
decodePair :: Text
decodePair = [Text] -> Text
T.unlines
[ Text
"elmStreetDecodePair : Decoder a -> Decoder b -> Decoder (a, b)"
, Text
"elmStreetDecodePair decA decB = D.map2 Tuple.pair (D.index 0 decA) (D.index 1 decB)"
]
decodeNonEmpty :: Text
decodeNonEmpty :: Text
decodeNonEmpty = [Text] -> Text
T.unlines
[ Text
"elmStreetDecodeNonEmpty : Decoder a -> Decoder (a, List a)"
, Text
"elmStreetDecodeNonEmpty decA = D.list decA |> D.andThen (\\xs -> case xs of"
, Text
" h::t -> D.succeed (h, t)"
, Text
" _ -> D.fail \"Expecting non-empty array\")"
]
decodeTriple :: Text
decodeTriple :: Text
decodeTriple = [Text] -> Text
T.unlines
[ Text
"elmStreetDecodeTriple : Decoder a -> Decoder b -> Decoder c -> Decoder (a, b, c)"
, Text
"elmStreetDecodeTriple decA decB decC = D.map3 (\\a b c -> (a,b,c)) (D.index 0 decA) (D.index 1 decB) (D.index 2 decC)"
]