{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Client.CodeGen.AST
( AesonField,
ClientDeclaration (..),
ClientMethod (..),
ClientPreDeclaration (..),
DERIVING_MODE (..),
MValue (..),
RequestTypeDefinition (..),
UnionPat (..),
ClientTypeDefinition (..),
)
where
import Data.Aeson (parseJSON)
import Data.Foldable (foldr1)
import Data.Morpheus.Client.CodeGen.Internal
( withObject,
withUnion,
)
import Data.Morpheus.CodeGen.Internal.AST
( CodeGenConstructor (..),
CodeGenType,
CodeGenTypeName,
PrintableValue (..),
TypeClassInstance,
printTHName,
)
import Data.Morpheus.CodeGen.TH
( PrintExp (..),
ToName (toName),
toCon,
toString,
toVar,
v',
)
import Data.Morpheus.Types.Internal.AST (FieldName, OperationType, TypeKind, TypeName, unpackName)
import Language.Haskell.TH
import Prettyprinter
( Doc,
Pretty (..),
indent,
line,
space,
vsep,
(<+>),
)
import Relude hiding (lift, show, toString)
import Prelude (show)
data DERIVING_MODE = SCALAR_MODE | ENUM_MODE | TYPE_MODE
data ClientDeclaration
= InstanceDeclaration DERIVING_MODE (TypeClassInstance ClientMethod)
| ClientTypeDeclaration CodeGenType
data ClientPreDeclaration
= ToJSONClass DERIVING_MODE CodeGenType
| FromJSONClass DERIVING_MODE CodeGenType
| FromJSONUnionClass CodeGenTypeName [(UnionPat, (CodeGenTypeName, Maybe String))]
| FromJSONObjectClass CodeGenTypeName CodeGenConstructor
| RequestTypeClass RequestTypeDefinition
| ClientType CodeGenType
data ClientTypeDefinition = ClientTypeDefinition
{ ClientTypeDefinition -> CodeGenTypeName
clientTypeName :: CodeGenTypeName,
ClientTypeDefinition -> [CodeGenConstructor]
clientCons :: [CodeGenConstructor],
ClientTypeDefinition -> TypeKind
clientKind :: TypeKind
}
deriving (Int -> ClientTypeDefinition -> ShowS
[ClientTypeDefinition] -> ShowS
ClientTypeDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientTypeDefinition] -> ShowS
$cshowList :: [ClientTypeDefinition] -> ShowS
show :: ClientTypeDefinition -> String
$cshow :: ClientTypeDefinition -> String
showsPrec :: Int -> ClientTypeDefinition -> ShowS
$cshowsPrec :: Int -> ClientTypeDefinition -> ShowS
Show)
data RequestTypeDefinition = RequestTypeDefinition
{ RequestTypeDefinition -> TypeName
requestName :: TypeName,
RequestTypeDefinition -> TypeName
requestArgs :: TypeName,
RequestTypeDefinition -> OperationType
requestType :: OperationType,
RequestTypeDefinition -> String
requestQuery :: String
}
deriving (Int -> RequestTypeDefinition -> ShowS
[RequestTypeDefinition] -> ShowS
RequestTypeDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestTypeDefinition] -> ShowS
$cshowList :: [RequestTypeDefinition] -> ShowS
show :: RequestTypeDefinition -> String
$cshow :: RequestTypeDefinition -> String
showsPrec :: Int -> RequestTypeDefinition -> ShowS
$cshowsPrec :: Int -> RequestTypeDefinition -> ShowS
Show)
instance Pretty ClientDeclaration where
pretty :: forall ann. ClientDeclaration -> Doc ann
pretty (ClientTypeDeclaration CodeGenType
def) = forall a ann. Pretty a => a -> Doc ann
pretty CodeGenType
def
pretty (InstanceDeclaration DERIVING_MODE
_ TypeClassInstance ClientMethod
def) = forall a ann. Pretty a => a -> Doc ann
pretty TypeClassInstance ClientMethod
def
data ClientMethod
= PrintableMethod PrintableValue
| FunctionNameMethod Name
| MatchMethod ValueMatch
| ToJSONObjectMethod Name [(FieldName, Name, Name)]
| FromJSONObjectMethod TypeName [AesonField]
| FromJSONUnionMethod [([UnionPat], (Name, Maybe Name))]
type AesonField = (Name, Name, FieldName)
instance Pretty ClientMethod where
pretty :: forall ann. ClientMethod -> Doc ann
pretty (FunctionNameMethod Name
x) = forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall ann. Name -> Doc ann
printTHName Name
x
pretty (PrintableMethod PrintableValue
x) = forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrintableValue
x
pretty (MatchMethod ValueMatch
x) = forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall n. ValueMatch -> Doc n
printMatchDoc ValueMatch
x
pretty (ToJSONObjectMethod Name
name [(FieldName, Name, Name)]
fields) = forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. Name -> Doc ann
printTHName Name
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall (t :: * -> *) ann. Foldable t => t (Doc ann) -> Doc ann
list (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {ann}. Show a => (a, Name, Name) -> Doc ann
mkEntry [(FieldName, Name, Name)]
fields)))
where
mkEntry :: (a, Name, Name) -> Doc ann
mkEntry (a
n, Name
o, Name
v) = forall a ann. Show a => a -> Doc ann
prettyLit a
n forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Name -> Doc ann
printTHName Name
o forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Name -> Doc ann
printTHName Name
v
pretty (FromJSONObjectMethod TypeName
name [AesonField]
xs) = Doc ann -> Doc ann
withBody forall a b. (a -> b) -> a -> b
$ forall n. (Name, [AesonField]) -> Doc n
printObjectDoc (forall a. ToName a => a -> Name
toName TypeName
name, [AesonField]
xs)
where
withBody :: Doc ann -> Doc ann
withBody Doc ann
body = forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc ann
"withObject" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
prettyLit TypeName
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"(\\v ->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
body forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
pretty (FromJSONUnionMethod [([UnionPat], (Name, Maybe Name))]
xs) = forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann
"withUnion" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall (t :: * -> *) ann. Foldable t => t (Doc ann) -> Doc ann
tuple [forall ann. Int -> Doc ann -> Doc ann
indent Int
1 (forall n. [(Doc n, Doc n)] -> Doc n
matchDoc forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {ann} {n}.
([UnionPat], (Name, Maybe Name)) -> (Doc ann, Doc n)
toMatch [([UnionPat], (Name, Maybe Name))]
xs) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line]))
where
toMatch :: ([UnionPat], (Name, Maybe Name)) -> (Doc ann, Doc n)
toMatch ([UnionPat]
pat, (Name, Maybe Name)
expr) = (forall (t :: * -> *) ann. Foldable t => t (Doc ann) -> Doc ann
tuple forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {ann}. UnionPat -> Doc ann
mapP [UnionPat]
pat, forall n. (Name, Maybe Name) -> Doc n
printVariantDoc (Name, Maybe Name)
expr)
mapP :: UnionPat -> Doc ann
mapP (UString TypeName
v) = forall a ann. Show a => a -> Doc ann
prettyLit TypeName
v
mapP (UVar String
v) = forall a ann. Pretty a => a -> Doc ann
pretty String
v
list :: Foldable t => t (Doc ann) -> Doc ann
list :: forall (t :: * -> *) ann. Foldable t => t (Doc ann) -> Doc ann
list t (Doc ann)
xs = Doc ann
"[" forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
1 (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Doc ann
a Doc ann
b -> Doc ann
a forall a. Semigroup a => a -> a -> a
<> Doc ann
"," forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> Doc ann
b) t (Doc ann)
xs) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"
tuple :: Foldable t => t (Doc ann) -> Doc ann
tuple :: forall (t :: * -> *) ann. Foldable t => t (Doc ann) -> Doc ann
tuple t (Doc ann)
ls = Doc ann
"(" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Doc ann
a Doc ann
b -> Doc ann
a forall a. Semigroup a => a -> a -> a
<> Doc ann
"," forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
b) t (Doc ann)
ls forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
instance PrintExp ClientMethod where
printExp :: ClientMethod -> Q Exp
printExp (FunctionNameMethod Name
v) = forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
v
printExp (PrintableMethod PrintableValue
v) = forall a. PrintExp a => a -> Q Exp
printExp PrintableValue
v
printExp (MatchMethod ValueMatch
p) = ValueMatch -> Q Exp
printMatchExp ValueMatch
p
printExp (ToJSONObjectMethod Name
name [(FieldName, Name, Name)]
fields) = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
name) (forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {a} {a} {a}.
(Quote m, ToString a (m Exp), ToVar a (m Exp), ToVar a (m Exp)) =>
(a, a, a) -> m Exp
mkEntry [(FieldName, Name, Name)]
fields)
where
mkEntry :: (a, a, a) -> m Exp
mkEntry (a
n, a
o, a
v) = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (forall a b. ToString a b => a -> b
toString a
n) (forall a b. ToVar a b => a -> b
toVar a
o) (forall a b. ToVar a b => a -> b
toVar a
v)
printExp (FromJSONObjectMethod TypeName
name [AesonField]
fields) = Q Exp -> Q Exp
withBody forall a b. (a -> b) -> a -> b
$ (Name, [AesonField]) -> Q Exp
printObjectExp (forall a. ToName a => a -> Name
toName TypeName
name, [AesonField]
fields)
where
withBody :: Q Exp -> Q Exp
withBody Q Exp
body = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall a b. ToVar a b => a -> b
toVar 'withObject) (forall a b. ToString a b => a -> b
toString TypeName
name)) (forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [forall a. ToVar Name a => a
v'] Q Exp
body)
printExp (FromJSONUnionMethod [([UnionPat], (Name, Maybe Name))]
matches) = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall a b. ToVar a b => a -> b
toVar 'withUnion) ([(PatQ, Q Exp)] -> Q Exp
matchExp forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *}.
(Quote m, ToString TypeName (m Pat), ToVar String (m Pat)) =>
([UnionPat], (Name, Maybe Name)) -> (m Pat, Q Exp)
toMatch [([UnionPat], (Name, Maybe Name))]
matches)
where
toMatch :: ([UnionPat], (Name, Maybe Name)) -> (m Pat, Q Exp)
toMatch ([UnionPat]
pat, (Name, Maybe Name)
expr) = (forall (m :: * -> *). Quote m => [m Pat] -> m Pat
tupP forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (ToString TypeName b, ToVar String b) => UnionPat -> b
mapP [UnionPat]
pat, (Name, Maybe Name) -> Q Exp
printVariantExp (Name, Maybe Name)
expr)
mapP :: UnionPat -> b
mapP (UString TypeName
v) = forall a b. ToString a b => a -> b
toString TypeName
v
mapP (UVar String
v) = forall a b. ToVar a b => a -> b
toVar String
v
printVariantExp :: (Name, Maybe Name) -> ExpQ
printVariantExp :: (Name, Maybe Name) -> Q Exp
printVariantExp (Name
con, Just Name
x) = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (forall a b. ToCon a b => a -> b
toCon Name
con) [|(<$>)|] (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall a b. ToVar a b => a -> b
toVar 'parseJSON) (forall a b. ToVar a b => a -> b
toVar Name
x))
printVariantExp (Name
con, Maybe Name
Nothing) = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|pure|] (forall a b. ToCon a b => a -> b
toCon Name
con)
printVariantDoc :: (Name, Maybe Name) -> Doc n
printVariantDoc :: forall n. (Name, Maybe Name) -> Doc n
printVariantDoc (Name
con, Just Name
x) = forall ann. Name -> Doc ann
printTHName Name
con forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"<$>" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"parseJSON" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Name -> Doc ann
printTHName Name
x
printVariantDoc (Name
con, Maybe Name
Nothing) = Doc n
"pure" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Name -> Doc ann
printTHName Name
con
printObjectExp :: (Name, [AesonField]) -> ExpQ
printObjectExp :: (Name, [AesonField]) -> Q Exp
printObjectExp (Name
con, [AesonField]
fields)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AesonField]
fields = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|pure|] (forall a b. ToCon a b => a -> b
toCon Name
con)
| Bool
otherwise = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (forall a b. ToCon a b => a -> b
toCon Name
con) [|(<$>)|] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Q Exp
x -> forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE Q Exp
x [|(<*>)|]) (forall a b. (a -> b) -> [a] -> [b]
map AesonField -> Q Exp
printFieldExp [AesonField]
fields)
printObjectDoc :: (Name, [AesonField]) -> Doc n
printObjectDoc :: forall n. (Name, [AesonField]) -> Doc n
printObjectDoc (Name
name, [AesonField]
fields)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AesonField]
fields = Doc n
"pure" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Name -> Doc ann
printTHName Name
name
| Bool
otherwise = forall ann. Name -> Doc ann
printTHName Name
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"<$>" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Doc n
a Doc n
b -> Doc n
a forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"<*>" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
b) (forall a b. (a -> b) -> [a] -> [b]
map forall n. AesonField -> Doc n
printFieldDoc [AesonField]
fields)
printFieldExp :: AesonField -> ExpQ
printFieldExp :: AesonField -> Q Exp
printFieldExp (Name
v, Name
o, FieldName
str) = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (forall a b. ToVar a b => a -> b
toVar Name
v) (forall a b. ToVar a b => a -> b
toVar Name
o) (forall a b. ToString a b => a -> b
toString FieldName
str)
printFieldDoc :: AesonField -> Doc n
printFieldDoc :: forall n. AesonField -> Doc n
printFieldDoc (Name
v, Name
o, FieldName
l) = forall ann. Name -> Doc ann
printTHName Name
v forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Name -> Doc ann
printTHName Name
o forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
prettyLit FieldName
l
prettyLit :: Show a => a -> Doc ann
prettyLit :: forall a ann. Show a => a -> Doc ann
prettyLit a
a = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show a
a)
prettyName :: TypeName -> Doc ann
prettyName :: forall ann. TypeName -> Doc ann
prettyName TypeName
a = forall a ann. Pretty a => a -> Doc ann
pretty (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
a :: Text)
data UnionPat
= UString TypeName
| UVar String
data MValue
= MFrom TypeName TypeName
| MTo TypeName TypeName
| MFunction String Name
type ValueMatch = [MValue]
printMatchDoc :: ValueMatch -> Doc n
printMatchDoc :: forall n. ValueMatch -> Doc n
printMatchDoc = forall n. [(Doc n, Doc n)] -> Doc n
matchDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {ann} {ann}. MValue -> (Doc ann, Doc ann)
buildMatch
where
buildMatch :: MValue -> (Doc ann, Doc ann)
buildMatch (MFrom TypeName
a TypeName
b) = (forall a ann. Show a => a -> Doc ann
prettyLit TypeName
a, Doc ann
"pure" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. TypeName -> Doc ann
prettyName TypeName
b)
buildMatch (MTo TypeName
a TypeName
b) = (forall ann. TypeName -> Doc ann
prettyName TypeName
a, forall a ann. Show a => a -> Doc ann
prettyLit TypeName
b)
buildMatch (MFunction String
v Name
name) = (forall a ann. Pretty a => a -> Doc ann
pretty String
v, forall ann. Name -> Doc ann
printTHName Name
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
v)
printMatchExp :: ValueMatch -> ExpQ
printMatchExp :: ValueMatch -> Q Exp
printMatchExp = [(PatQ, Q Exp)] -> Q Exp
matchExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {a}.
(Quote m, ToCon TypeName a, ToCon TypeName (m Exp),
ToString TypeName a, ToString TypeName (m Exp), ToVar String a,
ToVar Name (m Exp)) =>
MValue -> (a, m Exp)
buildMatch
where
buildMatch :: MValue -> (a, m Exp)
buildMatch (MFrom TypeName
a TypeName
b) = (forall a b. ToString a b => a -> b
toString TypeName
a, forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall a b. ToVar a b => a -> b
toVar 'pure) (forall a b. ToCon a b => a -> b
toCon TypeName
b))
buildMatch (MTo TypeName
a TypeName
b) = (forall a b. ToCon a b => a -> b
toCon TypeName
a, forall a b. ToString a b => a -> b
toString TypeName
b)
buildMatch (MFunction String
v Name
name) = (forall a b. ToVar a b => a -> b
toVar String
v, forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
name) forall a. ToVar Name a => a
v')
matchExp :: [(PatQ, ExpQ)] -> ExpQ
matchExp :: [(PatQ, Q Exp)] -> Q Exp
matchExp [(PatQ, Q Exp)]
xs = forall (m :: * -> *). Quote m => [m Match] -> m Exp
lamCaseE (forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *}. Quote m => (m Pat, m Exp) -> m Match
buildMatch [(PatQ, Q Exp)]
xs)
where
buildMatch :: (m Pat, m Exp) -> m Match
buildMatch (m Pat
pat, m Exp
fb) = forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match m Pat
pat (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
fb) []
matchDoc :: [(Doc n, Doc n)] -> Doc n
matchDoc :: forall n. [(Doc n, Doc n)] -> Doc n
matchDoc = ((Doc n
"\\case" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line) forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Int -> Doc ann -> Doc ann
indent Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {ann}. (Doc ann, Doc ann) -> Doc ann
buildMatch
where
buildMatch :: (Doc ann, Doc ann) -> Doc ann
buildMatch (Doc ann
pat, Doc ann
fb) = Doc ann
pat forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
fb