{-# 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