{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
module Servant.Elm.Internal.Generate where

import           Prelude                      hiding ((<$>))
import           Control.Lens                 (to, (^.))
import           Data.List                    (intercalate, intersperse, nub)
import           Data.Maybe                   (catMaybes)
import           Data.Proxy                   (Proxy(..))
import           Data.Text                    (Text)
import qualified Data.Text                    as T
import qualified Data.Text.Lazy               as L
import qualified Data.Text.Encoding           as T
import           Data.Text.IO                 as TIO

import           Elm.Json (jsonParserForType, jsonSerForType)
import qualified Elm.Module                   as Elm
import           Elm.TyRep (ETCon(..), EType(..), ETypeDef(..), toElmType)
import           Elm.TyRender (renderElm)
#if MIN_VERSION_elm_bridge(0,6,0)
import           Elm.Versions (ElmVersion(Elm0p19))
#else
import           Elm.Versions (ElmVersion(Elm0p18))
#endif
import           Servant.Elm.Internal.Foreign (LangElm, getEndpoints)
import qualified Servant.Foreign              as F
import           System.Directory (createDirectoryIfMissing)
import           Text.PrettyPrint.Leijen.Text


toElmTypeRefWith :: ElmOptions -> EType -> Text
toElmTypeRefWith :: ElmOptions -> EType -> Text
toElmTypeRefWith ElmOptions{[EType]
UrlPrefix
ETypeDef -> ETypeDef
EType -> Text
EType -> EType
stringElmTypes :: ElmOptions -> [EType]
emptyResponseElmTypes :: ElmOptions -> [EType]
elmToString :: ElmOptions -> EType -> Text
elmAlterations :: ElmOptions -> ETypeDef -> ETypeDef
elmTypeAlterations :: ElmOptions -> EType -> EType
urlPrefix :: ElmOptions -> UrlPrefix
stringElmTypes :: [EType]
emptyResponseElmTypes :: [EType]
elmToString :: EType -> Text
elmAlterations :: ETypeDef -> ETypeDef
elmTypeAlterations :: EType -> EType
urlPrefix :: UrlPrefix
..} = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ElmRenderable a => a -> String
renderElm forall b c a. (b -> c) -> (a -> b) -> a -> c
. EType -> EType
elmTypeAlterations

toElmDecoderRefWith :: ElmOptions -> EType -> Text
toElmDecoderRefWith :: ElmOptions -> EType -> Text
toElmDecoderRefWith ElmOptions{[EType]
UrlPrefix
ETypeDef -> ETypeDef
EType -> Text
EType -> EType
stringElmTypes :: [EType]
emptyResponseElmTypes :: [EType]
elmToString :: EType -> Text
elmAlterations :: ETypeDef -> ETypeDef
elmTypeAlterations :: EType -> EType
urlPrefix :: UrlPrefix
stringElmTypes :: ElmOptions -> [EType]
emptyResponseElmTypes :: ElmOptions -> [EType]
elmToString :: ElmOptions -> EType -> Text
elmAlterations :: ElmOptions -> ETypeDef -> ETypeDef
elmTypeAlterations :: ElmOptions -> EType -> EType
urlPrefix :: ElmOptions -> UrlPrefix
..} = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. EType -> String
jsonParserForType forall b c a. (b -> c) -> (a -> b) -> a -> c
. EType -> EType
elmTypeAlterations

toElmEncoderRefWith :: ElmOptions -> EType -> Text
toElmEncoderRefWith :: ElmOptions -> EType -> Text
toElmEncoderRefWith ElmOptions{[EType]
UrlPrefix
ETypeDef -> ETypeDef
EType -> Text
EType -> EType
stringElmTypes :: [EType]
emptyResponseElmTypes :: [EType]
elmToString :: EType -> Text
elmAlterations :: ETypeDef -> ETypeDef
elmTypeAlterations :: EType -> EType
urlPrefix :: UrlPrefix
stringElmTypes :: ElmOptions -> [EType]
emptyResponseElmTypes :: ElmOptions -> [EType]
elmToString :: ElmOptions -> EType -> Text
elmAlterations :: ElmOptions -> ETypeDef -> ETypeDef
elmTypeAlterations :: ElmOptions -> EType -> EType
urlPrefix :: ElmOptions -> UrlPrefix
..} = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. EType -> String
jsonSerForType forall b c a. (b -> c) -> (a -> b) -> a -> c
. EType -> EType
elmTypeAlterations

{-|
Options to configure how code is generated.
-}
data ElmOptions = ElmOptions
  { {- | The protocol, host and any path prefix to be used as the base for all
    requests.

    Example: @Static "https://mydomain.com/api/v1"@

    When @Dynamic@, the generated Elm functions take the base URL as the first
    argument.
    -}
    ElmOptions -> UrlPrefix
urlPrefix             :: UrlPrefix
  , ElmOptions -> EType -> EType
elmTypeAlterations        :: (EType -> EType)
    -- ^ Alterations to perform on ETypes before code generation.
  , ElmOptions -> ETypeDef -> ETypeDef
elmAlterations        :: (ETypeDef -> ETypeDef)
    -- ^ Alterations to perform on ETypeDefs before code generation.
  , ElmOptions -> EType -> Text
elmToString          :: (EType -> Text)
    -- ^ Elm functions creating a string from a given type.
  , ElmOptions -> [EType]
emptyResponseElmTypes :: [EType]
    -- ^ Types that represent an empty Http response.
  , ElmOptions -> [EType]
stringElmTypes        :: [EType]
    -- ^ Types that represent a String.
  }


data UrlPrefix
  = Static T.Text
  | Dynamic

type Namespace = [String]

{-|
Default options for generating Elm code.

The default options are:

> { urlPrefix =
>     Static ""
> , elmAlterations =
>     Elm.defaultTypeAlterations
> , emptyResponseElmTypes =
>     [ getType (Proxy :: Proxy ()) ]
> , stringElmTypes =
>     [ getType (Proxy :: Proxy String)
>     , getType (Proxy :: Proxy T.Text) ]
> }
-}
defElmOptions :: ElmOptions
defElmOptions :: ElmOptions
defElmOptions = ElmOptions
  { urlPrefix :: UrlPrefix
urlPrefix = Text -> UrlPrefix
Static Text
""
  , elmTypeAlterations :: EType -> EType
elmTypeAlterations = EType -> EType
Elm.defaultTypeAlterations
  , elmAlterations :: ETypeDef -> ETypeDef
elmAlterations = ETypeDef -> ETypeDef
Elm.defaultAlterations
  , elmToString :: EType -> Text
elmToString = EType -> Text
defaultElmToString
  , emptyResponseElmTypes :: [EType]
emptyResponseElmTypes =
      [ forall a. Typeable a => Proxy a -> EType
toElmType (forall {k} (t :: k). Proxy t
Proxy :: Proxy ())
      ]
  , stringElmTypes :: [EType]
stringElmTypes =
      [ forall a. Typeable a => Proxy a -> EType
toElmType (forall {k} (t :: k). Proxy t
Proxy :: Proxy String)
      , forall a. Typeable a => Proxy a -> EType
toElmType (forall {k} (t :: k). Proxy t
Proxy :: Proxy T.Text)
      ]
  }


{-|
Default imports required by generated Elm code.

You probably want to include this at the top of your generated Elm module.

The default required imports are:

> import Json.Decode
> import Json.Encode exposing (Value)
> -- The following module comes from bartavelle/json-helpers
> import Json.Helpers exposing (..)
> import Dict exposing (Dict)
> import Set
> import Http
> import String
> import Url.Builder
-}
defElmImports :: Text
defElmImports :: Text
defElmImports =
  [Text] -> Text
T.unlines
    [ Text
"import Json.Decode"
    , Text
"import Json.Encode exposing (Value)"
    , Text
"-- The following module comes from bartavelle/json-helpers"
    , Text
"import Json.Helpers exposing (..)"
    , Text
"import Dict exposing (Dict)"
    , Text
"import Set"
    , Text
"import Http"
    , Text
"import String"
    , Text
"import Url.Builder"
    ]

{-|
Helper to generate a complete Elm module given a list of Elm type definitions
and an API.
-}
generateElmModuleWith ::
     ( F.HasForeign LangElm EType api
     , F.GenerateList EType (F.Foreign EType api)
     )
  => ElmOptions
  -> Namespace
  -> Text
  -> FilePath
  -> [Elm.DefineElm]
  -> Proxy api
  -> IO ()
generateElmModuleWith :: forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
ElmOptions
-> Namespace -> Text -> String -> [DefineElm] -> Proxy api -> IO ()
generateElmModuleWith ElmOptions
options Namespace
namespace Text
imports String
rootDir [DefineElm]
typeDefs Proxy api
api = do
  let out :: Text
out =
        [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
        [
#if MIN_VERSION_elm_bridge(0,6,0)
          String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ElmVersion -> String -> String
Elm.moduleHeader ElmVersion
Elm0p19 String
moduleName
#else
          T.pack $ Elm.moduleHeader Elm0p18 moduleName
#endif
        , Text
""
        , Text
imports
        , String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ (ETypeDef -> ETypeDef) -> [DefineElm] -> String
Elm.makeModuleContentWithAlterations (ElmOptions -> ETypeDef -> ETypeDef
elmAlterations ElmOptions
options) [DefineElm]
typeDefs
        ] forall a. [a] -> [a] -> [a]
++
        forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
ElmOptions -> Proxy api -> [Text]
generateElmForAPIWith ElmOptions
options Proxy api
api
      moduleName :: String
moduleName = forall a. [a] -> [[a]] -> [a]
intercalate String
"." Namespace
namespace
      filePath :: String
filePath = forall a. [a] -> [[a]] -> [a]
intercalate String
"/" forall a b. (a -> b) -> a -> b
$ String
rootDirforall a. a -> [a] -> [a]
:forall a. [a] -> [a]
init Namespace
namespace
      fileName :: String
fileName = forall a. [a] -> [[a]] -> [a]
intercalate String
"/" forall a b. (a -> b) -> a -> b
$ String
filePathforall a. a -> [a] -> [a]
:[forall a. [a] -> a
last Namespace
namespace forall a. [a] -> [a] -> [a]
++ String
".elm"]
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
filePath
  String -> Text -> IO ()
TIO.writeFile String
fileName Text
out

{-|
Calls generateElmModuleWith with @defElmOptions@.
-}
generateElmModule ::
     ( F.HasForeign LangElm EType api
     , F.GenerateList EType (F.Foreign EType api)
     )
  => Namespace
  -> Text
  -> FilePath
  -> [Elm.DefineElm]
  -> Proxy api
  -> IO ()
generateElmModule :: forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
Namespace -> Text -> String -> [DefineElm] -> Proxy api -> IO ()
generateElmModule Namespace
namespace Text
imports String
filePath [DefineElm]
typeDefs Proxy api
api =
  forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
ElmOptions
-> Namespace -> Text -> String -> [DefineElm] -> Proxy api -> IO ()
generateElmModuleWith ElmOptions
defElmOptions Namespace
namespace Text
imports String
filePath [DefineElm]
typeDefs Proxy api
api

{-|
Generate Elm code for the API with default options.

Returns a list of Elm functions to query your Servant API from Elm.

You could spit these out to a file and call them from your Elm code, but you
would be better off creating a 'Spec' with the result and using 'specsToDir',
which handles the module name for you.
-}
generateElmForAPI
  :: ( F.HasForeign LangElm EType api
     , F.GenerateList EType (F.Foreign EType api))
  => Proxy api
  -> [Text]
generateElmForAPI :: forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
Proxy api -> [Text]
generateElmForAPI =
  forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
ElmOptions -> Proxy api -> [Text]
generateElmForAPIWith ElmOptions
defElmOptions


{-|
Generate Elm code for the API with custom options.
-}
generateElmForAPIWith
  :: ( F.HasForeign LangElm EType api
     , F.GenerateList EType (F.Foreign EType api))
  => ElmOptions
  -> Proxy api
  -> [Text]
generateElmForAPIWith :: forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
ElmOptions -> Proxy api -> [Text]
generateElmForAPIWith ElmOptions
opts = forall a. a -> [a] -> [a]
intersperse Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Doc -> Text
docToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ElmOptions -> Req EType -> Doc
generateElmForRequest ElmOptions
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall api.
(HasForeign LangElm EType api,
 GenerateList EType (Foreign EType api)) =>
Proxy api -> [Req EType]
getEndpoints

i :: Int
i :: Int
i = Int
4

{-|
Generate an Elm function for one endpoint.
-}
generateElmForRequest :: ElmOptions -> F.Req EType -> Doc
generateElmForRequest :: ElmOptions -> Req EType -> Doc
generateElmForRequest ElmOptions
opts Req EType
request =
  Doc
funcDef
  where
    funcDef :: Doc
funcDef =
      [Doc] -> Doc
vsep
        [ Doc
fnName Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Doc
typeSignature
        , Doc
fnName Doc -> Doc -> Doc
<+> Doc
args Doc -> Doc -> Doc
<+> Doc
equals
        , case Maybe Doc
letParams of
            Just Doc
params ->
              Int -> Doc -> Doc
indent Int
i
              ([Doc] -> Doc
vsep [Doc
"let"
                    , Int -> Doc -> Doc
indent Int
i Doc
params
                    , Doc
"in"
                    , Int -> Doc -> Doc
indent Int
i Doc
elmRequest
                    ])
            Maybe Doc
Nothing ->
              Int -> Doc -> Doc
indent Int
i Doc
elmRequest
        ]

    fnName :: Doc
fnName =
      Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) FunctionName
F.reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> Text
replace forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Text
F.camelCase) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Doc
stext

    replace :: Text -> Text
replace = Text -> Text -> Text -> Text
T.replace Text
"-" Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"." Text
""

    typeSignature :: Doc
typeSignature =
      ElmOptions -> Req EType -> Doc
mkTypeSignature ElmOptions
opts Req EType
request

    args :: Doc
args =
      ElmOptions -> Req EType -> Doc
mkArgs ElmOptions
opts Req EType
request

    letParams :: Maybe Doc
letParams =
      ElmOptions -> Req EType -> Maybe Doc
mkLetParams ElmOptions
opts Req EType
request

    elmRequest :: Doc
elmRequest =
      ElmOptions -> Req EType -> Doc
mkRequest ElmOptions
opts Req EType
request


mkTypeSignature :: ElmOptions -> F.Req EType -> Doc
mkTypeSignature :: ElmOptions -> Req EType -> Doc
mkTypeSignature ElmOptions
opts Req EType
request =
  ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
" ->" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
    [ forall a. [Maybe a] -> [a]
catMaybes [Maybe Doc
urlPrefixType]
    , [Doc]
headerTypes
    , [Doc]
urlCaptureTypes
    , [Doc]
queryTypes
    , forall a. [Maybe a] -> [a]
catMaybes [Maybe Doc
bodyType, Maybe Doc
toMsgType, Maybe Doc
returnType]
    ]
  where
    urlPrefixType :: Maybe Doc
    urlPrefixType :: Maybe Doc
urlPrefixType =
        case (ElmOptions -> UrlPrefix
urlPrefix ElmOptions
opts) of
          UrlPrefix
Dynamic -> forall a. a -> Maybe a
Just Doc
"String"
          Static Text
_ -> forall a. Maybe a
Nothing

    elmTypeRef :: EType -> Doc
    elmTypeRef :: EType -> Doc
elmTypeRef EType
eType =
      Text -> Doc
stext (ElmOptions -> EType -> Text
toElmTypeRefWith ElmOptions
opts EType
eType)

    headerTypes :: [Doc]
    headerTypes :: [Doc]
headerTypes =
      [ HeaderArg EType
header forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens
  (HeaderArg ftype1) (HeaderArg ftype2) (Arg ftype1) (Arg ftype2)
F.headerArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
F.argType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to EType -> Doc
elmTypeRef
      | HeaderArg EType
header <- Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) [HeaderArg ftype]
F.reqHeaders
      , forall f. HeaderArg f -> Bool
isNotCookie HeaderArg EType
header
      ]

    urlCaptureTypes :: [Doc]
    urlCaptureTypes :: [Doc]
urlCaptureTypes =
        [ forall ftype. Segment ftype -> Arg ftype
F.captureArg Segment EType
capture forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
F.argType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to EType -> Doc
elmTypeRef
        | Segment EType
capture <- Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Url ftype)
F.reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) (Path ftype)
F.path
        , forall ftype. Segment ftype -> Bool
F.isCapture Segment EType
capture
        ]

    queryTypes :: [Doc]
    queryTypes :: [Doc]
queryTypes =
      [ QueryArg EType
arg forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens (QueryArg ftype1) (QueryArg ftype2) (Arg ftype1) (Arg ftype2)
F.queryArgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
F.argType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to EType -> Doc
elmTypeRef
      | QueryArg EType
arg <- Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Url ftype)
F.reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) [QueryArg ftype]
F.queryStr
      ]

    bodyType :: Maybe Doc
    bodyType :: Maybe Doc
bodyType =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EType -> Doc
elmTypeRef forall a b. (a -> b) -> a -> b
$ Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Maybe ftype)
F.reqBody

    toMsgType :: Maybe Doc
    toMsgType :: Maybe Doc
toMsgType = do
      Doc
result <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EType -> Doc
elmTypeRef forall a b. (a -> b) -> a -> b
$ Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Maybe ftype)
F.reqReturnType
      forall a. a -> Maybe a
Just (Doc
"(Result Http.Error " Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
result Doc -> Doc -> Doc
<+> Doc
" -> msg)")

    returnType :: Maybe Doc
    returnType :: Maybe Doc
returnType = do
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
"Cmd msg")


elmHeaderArg :: F.HeaderArg EType -> Doc
elmHeaderArg :: HeaderArg EType -> Doc
elmHeaderArg HeaderArg EType
header =
  Doc
"header_" forall a. Semigroup a => a -> a -> a
<>
  HeaderArg EType
header forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens
  (HeaderArg ftype1) (HeaderArg ftype2) (Arg ftype1) (Arg ftype2)
F.headerArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Arg ftype) PathSegment
F.argName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> Doc
stext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"-" Text
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> Text
F.unPathSegment)


elmCaptureArg :: F.Segment EType -> Doc
elmCaptureArg :: Segment EType -> Doc
elmCaptureArg Segment EType
segment =
  Doc
"capture_" forall a. Semigroup a => a -> a -> a
<>
  forall ftype. Segment ftype -> Arg ftype
F.captureArg Segment EType
segment forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Arg ftype) PathSegment
F.argName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> Doc
stext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
replace forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> Text
F.unPathSegment)
  where
    replace :: Text -> Text
replace = Text -> Text -> Text -> Text
T.replace Text
"-" Text
"_"


elmQueryArg :: F.QueryArg EType -> Doc
elmQueryArg :: QueryArg EType -> Doc
elmQueryArg QueryArg EType
arg =
  Doc
"query_" forall a. Semigroup a => a -> a -> a
<>
  QueryArg EType
arg forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens (QueryArg ftype1) (QueryArg ftype2) (Arg ftype1) (Arg ftype2)
F.queryArgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Arg ftype) PathSegment
F.argName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> Doc
stext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
replace forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> Text
F.unPathSegment)
  where
    replace :: Text -> Text
replace = Text -> Text -> Text -> Text
T.replace Text
"-" Text
"_"


elmBodyArg :: Doc
elmBodyArg :: Doc
elmBodyArg =
  Doc
"body"


isNotCookie :: F.HeaderArg f -> Bool
isNotCookie :: forall f. HeaderArg f -> Bool
isNotCookie HeaderArg f
header =
   HeaderArg f
header
     forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens
  (HeaderArg ftype1) (HeaderArg ftype2) (Arg ftype1) (Arg ftype2)
F.headerArg
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Arg ftype) PathSegment
F.argName
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((forall a. Eq a => a -> a -> Bool
/= Text
"cookie") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> Text
F.unPathSegment)


mkArgs
  :: ElmOptions
  -> F.Req EType
  -> Doc
mkArgs :: ElmOptions -> Req EType -> Doc
mkArgs ElmOptions
opts Req EType
request =
  ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$
    [ -- Dynamic url prefix
      case ElmOptions -> UrlPrefix
urlPrefix ElmOptions
opts of
        UrlPrefix
Dynamic -> [Doc
"urlBase"]
        Static Text
_ -> []
    , -- Headers
      [ HeaderArg EType -> Doc
elmHeaderArg HeaderArg EType
header
      | HeaderArg EType
header <- Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) [HeaderArg ftype]
F.reqHeaders
      , forall f. HeaderArg f -> Bool
isNotCookie HeaderArg EType
header
      ]
    , -- URL Captures
      [ Segment EType -> Doc
elmCaptureArg Segment EType
segment
      | Segment EType
segment <- Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Url ftype)
F.reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) (Path ftype)
F.path
      , forall ftype. Segment ftype -> Bool
F.isCapture Segment EType
segment
      ]
    , -- Query params
      [ QueryArg EType -> Doc
elmQueryArg QueryArg EType
arg
      | QueryArg EType
arg <- Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Url ftype)
F.reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) [QueryArg ftype]
F.queryStr
      ]
    , -- Request body
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. a -> b -> a
const [Doc
elmBodyArg]) (Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Maybe ftype)
F.reqBody)
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
"toMsg"
    ]


mkLetParams :: ElmOptions -> F.Req EType -> Maybe Doc
mkLetParams :: ElmOptions -> Req EType -> Maybe Doc
mkLetParams ElmOptions
opts Req EType
request =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Doc
"params =" Doc -> Doc -> Doc
<$>
           Int -> Doc -> Doc
indent Int
i (Doc
"List.filterMap identity" Doc -> Doc -> Doc
<$>
                      Doc -> Doc
parens (Doc
"List.concat" Doc -> Doc -> Doc
<$>
                              Int -> Doc -> Doc
indent Int
i ([Doc] -> Doc
elmList [Doc]
params)))
  where
    params :: [Doc]
    params :: [Doc]
params = forall a b. (a -> b) -> [a] -> [b]
map QueryArg EType -> Doc
paramToDoc (Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Url ftype)
F.reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) [QueryArg ftype]
F.queryStr)

    paramToDoc :: F.QueryArg EType -> Doc
    paramToDoc :: QueryArg EType -> Doc
paramToDoc QueryArg EType
qarg =
      -- something wrong with indentation here...
      case QueryArg EType
qarg forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (QueryArg ftype) ArgType
F.queryArgType of
        ArgType
F.Normal ->
          let
            argType :: EType
argType = QueryArg EType
qarg forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens (QueryArg ftype1) (QueryArg ftype2) (Arg ftype1) (Arg ftype2)
F.queryArgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
F.argType
            wrapped :: Bool
wrapped = EType -> Bool
isElmMaybeType EType
argType
            toStringSrc :: Doc
toStringSrc =
              ElmOptions -> EType -> Doc
toString ElmOptions
opts (EType -> EType
maybeOf EType
argType)
          in
              Doc
"[" Doc -> Doc -> Doc
<+> (if Bool
wrapped then Doc
elmName else Doc
"Just" Doc -> Doc -> Doc
<+> Doc
elmName) forall a. Semigroup a => a -> a -> a
<> Doc
line forall a. Semigroup a => a -> a -> a
<>
                (Int -> Doc -> Doc
indent Int
4 (Doc
"|> Maybe.map" Doc -> Doc -> Doc
<+> [Doc] -> Doc
composeRight [Doc
toStringSrc, Doc
"Url.Builder.string" Doc -> Doc -> Doc
<+> Doc -> Doc
dquotes Doc
name]))
                Doc -> Doc -> Doc
<+> Doc
"]"
              -- (if wrapped then name else "Just" <+> name) <$>
              -- indent 4 ("|> Maybe.map" <+> parens (toStringSrc <> "Http.encodeUri >> (++)" <+> dquotes (elmName <> equals)) <$>
              --           "|> Maybe.withDefault" <+> dquotes empty)

        ArgType
F.Flag ->
            Doc
"[" Doc -> Doc -> Doc
<+>
            (Doc
"if" Doc -> Doc -> Doc
<+> Doc
elmName Doc -> Doc -> Doc
<+> Doc
"then" Doc -> Doc -> Doc
<$>
            Int -> Doc -> Doc
indent Int
4 (Doc
"Just" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Doc
"Url.Builder.string" Doc -> Doc -> Doc
<+> Doc -> Doc
dquotes Doc
name Doc -> Doc -> Doc
<+> Doc -> Doc
dquotes Doc
empty)) Doc -> Doc -> Doc
<$>
            Int -> Doc -> Doc
indent Int
2 Doc
"else" Doc -> Doc -> Doc
<$>
            Int -> Doc -> Doc
indent Int
4 Doc
"Nothing")
            Doc -> Doc -> Doc
<+> Doc
"]"

        ArgType
F.List ->
            let
              argType :: EType
argType = QueryArg EType
qarg forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens (QueryArg ftype1) (QueryArg ftype2) (Arg ftype1) (Arg ftype2)
F.queryArgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
F.argType
              toStringSrc :: Doc
toStringSrc =
                ElmOptions -> EType -> Doc
toString ElmOptions
opts (EType -> EType
listOf (EType -> EType
maybeOf EType
argType))
            in
            Doc
elmName Doc -> Doc -> Doc
<$>
            Int -> Doc -> Doc
indent Int
4 (Doc
"|> List.map"
                      Doc -> Doc -> Doc
<+> [Doc] -> Doc
composeRight
                        [ Doc
toStringSrc
                        , Doc
"Url.Builder.string" Doc -> Doc -> Doc
<+> Doc -> Doc
dquotes (Doc
name forall a. Semigroup a => a -> a -> a
<> Doc
"[]")
                        , Doc
"Just"
                        ]
                      )

      where
        elmName :: Doc
elmName = QueryArg EType -> Doc
elmQueryArg QueryArg EType
qarg
        name :: Doc
name = QueryArg EType
qarg forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens (QueryArg ftype1) (QueryArg ftype2) (Arg ftype1) (Arg ftype2)
F.queryArgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Arg ftype) PathSegment
F.argName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> Doc
stext forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> Text
F.unPathSegment)


mkRequest :: ElmOptions -> F.Req EType -> Doc
mkRequest :: ElmOptions -> Req EType -> Doc
mkRequest ElmOptions
opts Req EType
request =
  Doc
"Http.request" Doc -> Doc -> Doc
<$>
  Int -> Doc -> Doc
indent Int
i
    ([Doc] -> Doc
elmRecord
       [ Doc
"method =" Doc -> Doc -> Doc
<$>
         Int -> Doc -> Doc
indent Int
i (Doc -> Doc
dquotes Doc
method)
       , Doc
"headers =" Doc -> Doc -> Doc
<$>
         Int -> Doc -> Doc
indent Int
i
           ([Doc] -> Doc
elmListOfMaybes [Doc]
headers)
       , Doc
"url =" Doc -> Doc -> Doc
<$>
         Int -> Doc -> Doc
indent Int
i Doc
url
       , Doc
"body =" Doc -> Doc -> Doc
<$>
         Int -> Doc -> Doc
indent Int
i Doc
body
       , Doc
"expect =" Doc -> Doc -> Doc
<$>
         Int -> Doc -> Doc
indent Int
i Doc
expect
       , Doc
"timeout =" Doc -> Doc -> Doc
<$>
         Int -> Doc -> Doc
indent Int
i Doc
"Nothing"
       , Doc
"tracker =" Doc -> Doc -> Doc
<$>
         Int -> Doc -> Doc
indent Int
i Doc
"Nothing"
       ])
  where
    method :: Doc
method =
       Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) Method
F.reqMethod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> Doc
stext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text
T.decodeUtf8)

    mkHeader :: HeaderArg EType -> Doc
mkHeader HeaderArg EType
header =
      let headerName :: Doc
headerName = HeaderArg EType
header forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens
  (HeaderArg ftype1) (HeaderArg ftype2) (Arg ftype1) (Arg ftype2)
F.headerArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Arg ftype) PathSegment
F.argName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> Doc
stext forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> Text
F.unPathSegment)
          headerArgName :: Doc
headerArgName = HeaderArg EType -> Doc
elmHeaderArg HeaderArg EType
header
          argType :: EType
argType = HeaderArg EType
header forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2.
Lens
  (HeaderArg ftype1) (HeaderArg ftype2) (Arg ftype1) (Arg ftype2)
F.headerArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
F.argType
          wrapped :: Bool
wrapped = EType -> Bool
isElmMaybeType EType
argType
          toStringSrc :: Doc
toStringSrc = ElmOptions -> EType -> Doc
toString ElmOptions
opts (EType -> EType
maybeOf EType
argType)
      in
        Doc
"Maybe.map" Doc -> Doc -> Doc
<+> [Doc] -> Doc
composeLeft [Doc
"Http.header" Doc -> Doc -> Doc
<+> Doc -> Doc
dquotes Doc
headerName, Doc
toStringSrc]
        Doc -> Doc -> Doc
<+>
        (if Bool
wrapped then Doc
headerArgName else Doc -> Doc
parens (Doc
"Just" Doc -> Doc -> Doc
<+> Doc
headerArgName))

    headers :: [Doc]
headers =
      [ HeaderArg EType -> Doc
mkHeader HeaderArg EType
header
      | HeaderArg EType
header <- Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) [HeaderArg ftype]
F.reqHeaders
      , forall f. HeaderArg f -> Bool
isNotCookie HeaderArg EType
header
      ]

    url :: Doc
url =
      ElmOptions -> [Segment EType] -> Doc
mkUrl ElmOptions
opts (Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Url ftype)
F.reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) (Path ftype)
F.path)
       forall a. Semigroup a => a -> a -> a
<> Req EType -> Doc
mkQueryParams Req EType
request

    body :: Doc
body =
      case Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Maybe ftype)
F.reqBody of
        Maybe EType
Nothing ->
          Doc
"Http.emptyBody"

        Just EType
elmTypeExpr ->
          let
            encoderName :: Text
encoderName =
              ElmOptions -> EType -> Text
toElmEncoderRefWith ElmOptions
opts EType
elmTypeExpr
          in
            Doc
"Http.jsonBody" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Text -> Doc
stext Text
encoderName Doc -> Doc -> Doc
<+> Doc
elmBodyArg)

    expect :: Doc
expect =
      case Req EType
request forall s a. s -> Getting a s a -> a
^. forall ftype. Lens' (Req ftype) (Maybe ftype)
F.reqReturnType of
        Just EType
elmTypeExpr
          | ElmOptions -> EType -> Bool
isEmptyType ElmOptions
opts forall a b. (a -> b) -> a -> b
$ (ElmOptions -> EType -> EType
elmTypeAlterations ElmOptions
opts) EType
elmTypeExpr
            -- let elmConstructor = T.pack (renderElm elmTypeExpr)
           ->
            Doc
"Http.expectString " forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
indent Int
i Doc
"(\\x -> case x of" forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
<+>
            Int -> Doc -> Doc
indent Int
i Doc
"Err e -> toMsg (Err e)" forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
<+>
            Int -> Doc -> Doc
indent Int
i Doc
"Ok _ -> toMsg (Ok ()))"
        Just EType
elmTypeExpr ->
          Doc
"Http.expectJson toMsg" Doc -> Doc -> Doc
<+> EType -> Doc
renderDecoderName ((ElmOptions -> EType -> EType
elmTypeAlterations ElmOptions
opts) EType
elmTypeExpr)
        Maybe EType
Nothing -> forall a. HasCallStack => String -> a
error String
"mkHttpRequest: no reqReturnType?"
      -- case request ^. F.reqReturnType of
      --   Just elmTypeExpr | isEmptyType opts elmTypeExpr ->
      --     let elmConstructor =
      --           toElmTypeRefWith opts elmTypeExpr
      --     in
      --       "Http.expectStringResponse" <$>
      --       indent i (parens (backslash <> " rsp " <+> "->" <$>
      --                         indent i ("if String.isEmpty rsp.body then" <$>
      --                                   indent i "Ok" <+> stext elmConstructor <$>
      --                                   "else" <$>
      --                                   indent i ("Err" <+> dquotes "Expected the response body to be empty")) <> line))


      --   Just elmTypeExpr ->
      --     "Http.expectJson <|" <+> stext (toElmDecoderRefWith opts elmTypeExpr)

      --   Nothing ->
      --     error "mkHttpRequest: no reqReturnType?"

renderDecoderName :: EType -> Doc
renderDecoderName :: EType -> Doc
renderDecoderName EType
elmTypeExpr =
  case EType
elmTypeExpr of
    ETyApp (ETyCon (ETCon String
"List")) EType
t ->
      Doc -> Doc
parens (Doc
"Json.Decode.list " forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (EType -> Doc
renderDecoderName EType
t))
    ETyApp (ETyCon (ETCon String
"Maybe")) EType
t ->
      Doc -> Doc
parens (Doc
"Json.Decode.maybe " forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (EType -> Doc
renderDecoderName EType
t))
    ETyApp EType
x EType
y ->
      Doc -> Doc
parens (EType -> Doc
renderDecoderName EType
x Doc -> Doc -> Doc
<+> EType -> Doc
renderDecoderName EType
y)
    ETyCon (ETCon String
"Int") -> Doc
"Json.Decode.int"
    ETyCon (ETCon String
"String") -> Doc
"Json.Decode.string"
    EType
_ -> (Doc
"jsonDec" forall a. Semigroup a => a -> a -> a
<> Text -> Doc
stext (String -> Text
T.pack (forall a. ElmRenderable a => a -> String
renderElm EType
elmTypeExpr)))


mkUrl :: ElmOptions -> [F.Segment EType] -> Doc
mkUrl :: ElmOptions -> [Segment EType] -> Doc
mkUrl ElmOptions
opts [Segment EType]
segments =
  Doc
urlBuilder Doc -> Doc -> Doc
<$>
    (Int -> Doc -> Doc
indent Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
elmList)
    ( forall a b. (a -> b) -> [a] -> [b]
map Segment EType -> Doc
segmentToDoc [Segment EType]
segments)
  -- ( case urlPrefix opts of
  --     Dynamic -> "urlBase"
  --     Static url -> dquotes (stext url)
  --   : map segmentToDoc segments)
  where
    urlBuilder :: Doc
    urlBuilder :: Doc
urlBuilder = case ElmOptions -> UrlPrefix
urlPrefix ElmOptions
opts of
      UrlPrefix
Dynamic -> Doc
"Url.Builder.crossOrigin urlBase" :: Doc
      Static Text
url -> Doc
"Url.Builder.crossOrigin" Doc -> Doc -> Doc
<+> Doc -> Doc
dquotes (Text -> Doc
stext Text
url)

    segmentToDoc :: F.Segment EType -> Doc
    segmentToDoc :: Segment EType -> Doc
segmentToDoc Segment EType
s =
      case forall ftype. Segment ftype -> SegmentType ftype
F.unSegment Segment EType
s of
        F.Static PathSegment
path ->
          Doc -> Doc
dquotes (Text -> Doc
stext (PathSegment -> Text
F.unPathSegment PathSegment
path))
        F.Cap Arg EType
arg ->
          let
            toStringSrc :: Doc
toStringSrc =
              ElmOptions -> EType -> Doc
toString ElmOptions
opts (EType -> EType
maybeOf (Arg EType
arg forall s a. s -> Getting a s a -> a
^. forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
F.argType))
          in
            [Doc] -> Doc
pipeRight [Segment EType -> Doc
elmCaptureArg Segment EType
s, Doc
toStringSrc]


mkQueryParams
  :: F.Req EType
  -> Doc
mkQueryParams :: Req EType -> Doc
mkQueryParams Req EType
_request =
  -- if null (request ^. F.reqUrl . F.queryStr) then
  --   empty
  -- else
    Doc
line forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
indent Int
4 (Doc -> Doc
align Doc
"params")


{- | Determines whether we construct an Elm function that expects an empty
response body.
-}
isEmptyType :: ElmOptions -> EType -> Bool
isEmptyType :: ElmOptions -> EType -> Bool
isEmptyType ElmOptions
opts EType
elmTypeExpr =
  EType
elmTypeExpr forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ElmOptions -> [EType]
emptyResponseElmTypes ElmOptions
opts


{- | Determines whether we call `toString` on URL captures and query params of
this type in Elm.
-}
isElmStringType :: ElmOptions -> EType -> Bool
isElmStringType :: ElmOptions -> EType -> Bool
isElmStringType ElmOptions
opts EType
elmTypeExpr =
  EType
elmTypeExpr forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ElmOptions -> [EType]
stringElmTypes ElmOptions
opts

{- | Determines whether a type is 'Maybe a' where 'a' is something akin to a 'String'.
-}
isElmMaybeStringType :: ElmOptions -> EType -> Bool
isElmMaybeStringType :: ElmOptions -> EType -> Bool
isElmMaybeStringType ElmOptions
opts (ETyApp (ETyCon (ETCon String
"Maybe")) EType
elmTypeExpr) = EType
elmTypeExpr forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ElmOptions -> [EType]
stringElmTypes ElmOptions
opts
isElmMaybeStringType ElmOptions
_ EType
_ = Bool
False

isElmMaybeType :: EType -> Bool
isElmMaybeType :: EType -> Bool
isElmMaybeType (ETyApp (ETyCon (ETCon String
"Maybe")) EType
_) = Bool
True
isElmMaybeType EType
_ = Bool
False

isElmListOfMaybeBoolType :: EType -> Bool
isElmListOfMaybeBoolType :: EType -> Bool
isElmListOfMaybeBoolType EType
t =
  case EType
t of
    (ETyApp (ETyCon (ETCon String
"List")) (ETyApp (ETyCon (ETCon String
"Maybe")) (ETyCon (ETCon String
"Bool")))) -> Bool
True
    EType
_ -> Bool
False

-- Doc helpers


docToText :: Doc -> Text
docToText :: Doc -> Text
docToText =
  Text -> Text
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> Text
displayT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> Doc -> SimpleDoc
renderPretty Float
0.4 Int
100

stext :: Text -> Doc
stext :: Text -> Doc
stext = Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
L.fromStrict

elmRecord :: [Doc] -> Doc
elmRecord :: [Doc] -> Doc
elmRecord = Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep (Doc
lbrace forall a. Semigroup a => a -> a -> a
<> Doc
space) (Doc
line forall a. Semigroup a => a -> a -> a
<> Doc
rbrace) (Doc
comma forall a. Semigroup a => a -> a -> a
<> Doc
space)

elmList :: [Doc] -> Doc
elmList :: [Doc] -> Doc
elmList [] = Doc
lbracket forall a. Semigroup a => a -> a -> a
<> Doc
rbracket
elmList [Doc]
ds = Doc
lbracket Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate (Doc
line forall a. Semigroup a => a -> a -> a
<> Doc
comma) [Doc]
ds) Doc -> Doc -> Doc
<$> Doc
rbracket

elmListOfMaybes :: [Doc] -> Doc
elmListOfMaybes :: [Doc] -> Doc
elmListOfMaybes [] = Doc
lbracket forall a. Semigroup a => a -> a -> a
<> Doc
rbracket
elmListOfMaybes [Doc]
ds = Doc
"List.filterMap identity" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
elmList [Doc]
ds)

defaultElmToString :: EType -> Text
defaultElmToString :: EType -> Text
defaultElmToString EType
argType =
  case EType
argType of
    ETyCon (ETCon String
"Bool")             -> Text
"(\\value -> if value then \"true\" else \"false\")"
    ETyCon (ETCon String
"Float")            -> Text
"String.fromFloat"
    ETyCon (ETCon String
"Char")             -> Text
"String.fromChar"
    ETyApp (ETyCon (ETCon String
"Maybe")) EType
v -> Text
"(Maybe.map " forall a. Semigroup a => a -> a -> a
<> EType -> Text
defaultElmToString EType
v forall a. Semigroup a => a -> a -> a
<> Text
" >> Maybe.withDefault \"\")"
    EType
_                                 -> Text
"String.fromInt"


maybeOf :: EType -> EType
maybeOf :: EType -> EType
maybeOf (ETyApp (ETyCon (ETCon String
"Maybe")) EType
v) = EType
v
maybeOf EType
v = EType
v

listOf :: EType -> EType
listOf :: EType -> EType
listOf (ETyApp (ETyCon (ETCon String
"List")) EType
v) = EType
v
listOf EType
v = EType
v

toString :: ElmOptions -> EType -> Doc
toString :: ElmOptions -> EType -> Doc
toString ElmOptions
opts EType
argType =
  if ElmOptions -> EType -> Bool
isElmStringType ElmOptions
opts EType
argType then
    forall a. Monoid a => a
mempty
  else
    Text -> Doc
stext forall a b. (a -> b) -> a -> b
$ ElmOptions -> EType -> Text
elmToString ElmOptions
opts EType
argType

pipeLeft :: [Doc] -> Doc
pipeLeft :: [Doc] -> Doc
pipeLeft =
  Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lparen Doc
rparen Doc
" <| " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)

pipeRight :: [Doc] -> Doc
pipeRight :: [Doc] -> Doc
pipeRight =
  Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lparen Doc
rparen Doc
" |> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)

composeLeft :: [Doc] -> Doc
composeLeft :: [Doc] -> Doc
composeLeft =
  Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lparen Doc
rparen Doc
" << " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)

composeRight :: [Doc] -> Doc
composeRight :: [Doc] -> Doc
composeRight =
  Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lparen Doc
rparen Doc
" >> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)