{- | Pretty-printing functions for @Decoder.elm@ module.
Also contains decoders for common types which go to the @ElmStreet.elm@ module.
-}

module Elm.Print.Decoder
       ( prettyShowDecoder

         -- * Standard missing decoders
       , 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


----------------------------------------------------------------------------
-- Decode
----------------------------------------------------------------------------

{- |

__Sum Types:__

Haskell type

@
type User
    = Foo
    | Bar String Int
@

Encoded JSON on Haskell side

@
    [ { "tag" : "Foo"
      }
    , { "tag" : "Bar"
      , "contents" : ["asd", 42, "qwerty"]
      }
    ]
@

Elm decoder

@
userDecoder : Decoder User
userDecoder =
    let decide : String -> Decoder User
        decide x = case x of
            \"Foo\" -> D.succeed Foo
            \"Bar\" -> D.field "contents" <| D.map2 Bar (D.index 0 D.string) (D.index 1 D.int)
            x -> D.fail <| "There is no constructor for User type:" ++ x
    in D.andThen decide (D.field "tag" D.string)
@

-}
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
..} =
    -- function defenition: @encodeTypeName : TypeName -> Value@.
       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
       -- if this is Enum just using the read instance we wrote.
       then forall ann. Doc ann
enumDecoder
       else if Bool
elmTypeIsNewtype
            -- if it newtype then wrap decoder for the field
            then forall ann. Doc ann
newtypeDecoder
            -- If it sum type then it should look like: @{"tag": "Foo", "contents" : ["string", 1]}@
            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

        -- Use function map, map2, map3 etc.
        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

        -- create @(D.index 0 D.string)@ etc.
        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)

-- | Converts the reference to the existing type to the corresponding decoder.
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)

-- | The definition of the @decodeTYPENAME@ function.
decoderDef
    :: Text  -- ^ Type name
    -> [Text] -- ^ List of type variables
    -> 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)

-- | Create the name of the decoder function.
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

-- | @JSON@ decoder Elm help function for Enum types.
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"
    ]

-- | @JSON@ decoder Elm help function for 'Char's.
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"
    ]

-- | @JSON@ decoder Elm help function for 'Either's.
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
"    ]"
    ]

-- | @JSON@ decoder Elm help function for 2-tuples.
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)"
    ]

-- | @JSON@ decoder Elm help function for List.NonEmpty.
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\")"
    ]

-- | @JSON@ decoder Elm help function for 3-tuples.
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)"
    ]