{-# 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
data ElmOptions = ElmOptions
{
ElmOptions -> UrlPrefix
urlPrefix :: UrlPrefix
, ElmOptions -> EType -> EType
elmTypeAlterations :: (EType -> EType)
, ElmOptions -> ETypeDef -> ETypeDef
elmAlterations :: (ETypeDef -> ETypeDef)
, ElmOptions -> EType -> Text
elmToString :: (EType -> Text)
, ElmOptions -> [EType]
emptyResponseElmTypes :: [EType]
, ElmOptions -> [EType]
stringElmTypes :: [EType]
}
data UrlPrefix
= Static T.Text
| Dynamic
type Namespace = [String]
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)
]
}
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"
]
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
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
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
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
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
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
$
[
case ElmOptions -> UrlPrefix
urlPrefix ElmOptions
opts of
UrlPrefix
Dynamic -> [Doc
"urlBase"]
Static Text
_ -> []
,
[ 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
]
,
[ 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
]
,
[ 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
]
,
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 =
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
"]"
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
->
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?"
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)
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 =
Doc
line forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
indent Int
4 (Doc -> Doc
align Doc
"params")
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
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
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
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)