{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
module Language.Haskell.Codegen where
import Control.Lens
import Data.Generics.Labels ()
import Data.List
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Internal
import GHC.Generics
type Ann = Maybe Text
io :: Type
io :: Type
io = Text -> Type
Type "IO"
prettyDoc :: Ann -> Doc ann
prettyDoc :: Ann -> Doc ann
prettyDoc (Just d :: Text
d) =
let ls :: [Text]
ls = Text -> [Text]
T.lines Text
d
ds :: [Doc ann]
ds = (Text -> Doc ann) -> [Text] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines [Text]
ls
in "-- |" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall a. (a -> a -> a) -> [a] -> a
foldl1' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "--" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "--") [Doc ann]
ds) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line
prettyDoc Nothing = Doc ann
forall a. Monoid a => a
mempty
data ADT
= ADT
{ ADT -> Text
name :: Text,
ADT -> Ann
ann :: Ann,
ADT -> [Constr]
constr :: [Constr]
}
deriving (Int -> ADT -> ShowS
[ADT] -> ShowS
ADT -> String
(Int -> ADT -> ShowS)
-> (ADT -> String) -> ([ADT] -> ShowS) -> Show ADT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ADT] -> ShowS
$cshowList :: [ADT] -> ShowS
show :: ADT -> String
$cshow :: ADT -> String
showsPrec :: Int -> ADT -> ShowS
$cshowsPrec :: Int -> ADT -> ShowS
Show, ADT -> ADT -> Bool
(ADT -> ADT -> Bool) -> (ADT -> ADT -> Bool) -> Eq ADT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ADT -> ADT -> Bool
$c/= :: ADT -> ADT -> Bool
== :: ADT -> ADT -> Bool
$c== :: ADT -> ADT -> Bool
Eq, (forall x. ADT -> Rep ADT x)
-> (forall x. Rep ADT x -> ADT) -> Generic ADT
forall x. Rep ADT x -> ADT
forall x. ADT -> Rep ADT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ADT x -> ADT
$cfrom :: forall x. ADT -> Rep ADT x
Generic)
constructors :: ADT -> Int
constructors :: ADT -> Int
constructors ADT {..} = [Constr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constr]
constr
prettyConstrs :: [Doc ann] -> Doc ann
prettyConstrs :: [Doc ann] -> Doc ann
prettyConstrs [] = Doc ann
forall a. Monoid a => a
mempty
prettyConstrs (x :: Doc ann
x : xs :: [Doc ann]
xs) =
[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall a. (a -> a -> a) -> [a] -> a
foldl1' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "| ") (("=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
x) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
xs)),
"deriving (Show, Eq, Generic)"
]
instance Pretty ADT where
pretty :: ADT -> Doc ann
pretty ADT {..} =
let doc :: Doc ann
doc = Ann -> Doc ann
forall ann. Ann -> Doc ann
prettyDoc Ann
ann
n :: Doc ann
n = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines Text
name
cs :: [Doc ann]
cs = (Constr -> Doc ann) -> [Constr] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Constr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Constr]
constr
in Doc ann
doc
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ "data" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
n,
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyConstrs [Doc ann]
cs)
]
data Field
= Field
{ Field -> Text
name :: Text,
Field -> Ann
ann :: Ann,
Field -> Type
ty :: Type
}
deriving (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show, Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, (forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generic)
warpM :: Type -> Type
warpM :: Type -> Type
warpM (App (Type "[]") t' :: Type
t') = Type -> Type -> Type
App (Text -> Type
Type "[]") (Type -> Type
warpM Type
t')
warpM t :: Type
t = Type -> Type -> Type
App (Text -> Type
Type "Maybe") Type
t
instance Pretty Field where
pretty :: Field -> Doc ann
pretty Field {..} =
Ann -> Doc ann
forall ann. Ann -> Doc ann
prettyDoc Ann
ann
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
ty
data Constr
= Constr
{ Constr -> Text
name :: Text,
Constr -> Ann
ann :: Ann,
Constr -> [Field]
fields :: [Field]
}
deriving (Int -> Constr -> ShowS
[Constr] -> ShowS
Constr -> String
(Int -> Constr -> ShowS)
-> (Constr -> String) -> ([Constr] -> ShowS) -> Show Constr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constr] -> ShowS
$cshowList :: [Constr] -> ShowS
show :: Constr -> String
$cshow :: Constr -> String
showsPrec :: Int -> Constr -> ShowS
$cshowsPrec :: Int -> Constr -> ShowS
Show, Constr -> Constr -> Bool
(Constr -> Constr -> Bool)
-> (Constr -> Constr -> Bool) -> Eq Constr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constr -> Constr -> Bool
$c/= :: Constr -> Constr -> Bool
== :: Constr -> Constr -> Bool
$c== :: Constr -> Constr -> Bool
Eq, (forall x. Constr -> Rep Constr x)
-> (forall x. Rep Constr x -> Constr) -> Generic Constr
forall x. Rep Constr x -> Constr
forall x. Constr -> Rep Constr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Constr x -> Constr
$cfrom :: forall x. Constr -> Rep Constr x
Generic)
arity :: Constr -> Int
arity :: Constr -> Int
arity = [Field] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Field] -> Int) -> (Constr -> [Field]) -> Constr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> [Field]
fields
instance Pretty Constr where
pretty :: Constr -> Doc ann
pretty Constr {..} =
let doc :: Doc ann
doc = Ann -> Doc ann
forall ann. Ann -> Doc ann
prettyDoc Ann
ann
n :: Doc ann
n = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines Text
name
fs :: Doc ann
fs = (Doc ann -> Doc ann -> Doc ann) -> Doc ann -> [Doc ann] -> Doc ann
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) Doc ann
forall a. Monoid a => a
mempty (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse ("," Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line) ((Field -> Doc ann) -> [Field] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Field]
fields))
in Doc ann
doc
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ Doc ann
n,
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 2 ("{" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
fs Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "}")
]
data Type
= Type Text
| Arr Type Type
| App Type Type
deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, (forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generic)
instance Pretty Type where
pretty :: Type -> Doc ann
pretty (Type t :: Text
t) = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines Text
t
pretty (Arr ty :: Type
ty ty' :: Type
ty') = Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
ty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
ty'
pretty (App (Type "[]") ty :: Type
ty) = "[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
ty Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "]"
pretty (App tyCon :: Type
tyCon ty :: Type
ty) = "(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
tyCon Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ")" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
ty Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ")"
data TypeSig
= Result
{ TypeSig -> Type
ty :: Type,
TypeSig -> Ann
ann :: Ann
}
| Conn
{ ty :: Type,
ann :: Ann,
TypeSig -> TypeSig
res :: TypeSig
}
deriving (Int -> TypeSig -> ShowS
[TypeSig] -> ShowS
TypeSig -> String
(Int -> TypeSig -> ShowS)
-> (TypeSig -> String) -> ([TypeSig] -> ShowS) -> Show TypeSig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSig] -> ShowS
$cshowList :: [TypeSig] -> ShowS
show :: TypeSig -> String
$cshow :: TypeSig -> String
showsPrec :: Int -> TypeSig -> ShowS
$cshowsPrec :: Int -> TypeSig -> ShowS
Show, TypeSig -> TypeSig -> Bool
(TypeSig -> TypeSig -> Bool)
-> (TypeSig -> TypeSig -> Bool) -> Eq TypeSig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSig -> TypeSig -> Bool
$c/= :: TypeSig -> TypeSig -> Bool
== :: TypeSig -> TypeSig -> Bool
$c== :: TypeSig -> TypeSig -> Bool
Eq, (forall x. TypeSig -> Rep TypeSig x)
-> (forall x. Rep TypeSig x -> TypeSig) -> Generic TypeSig
forall x. Rep TypeSig x -> TypeSig
forall x. TypeSig -> Rep TypeSig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeSig x -> TypeSig
$cfrom :: forall x. TypeSig -> Rep TypeSig x
Generic)
instance Pretty TypeSig where
pretty :: TypeSig -> Doc ann
pretty (Result ty :: Type
ty doc :: Ann
doc) =
Ann -> Doc ann
forall ann. Ann -> Doc ann
prettyDoc Ann
doc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "Sem r" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "Error ∪" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
ty Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ")"
pretty (Conn ty :: Type
ty doc :: Ann
doc res :: TypeSig
res) =
Ann -> Doc ann
forall ann. Ann -> Doc ann
prettyDoc Ann
doc
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
ty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "->",
TypeSig -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TypeSig
res
]
type Annotated = (Type, Ann)
formArr :: [Annotated] -> Annotated -> TypeSig
formArr :: [Annotated] -> Annotated -> TypeSig
formArr [] (ty :: Type
ty, ann :: Ann
ann) = Type -> Ann -> TypeSig
Result Type
ty Ann
ann
formArr ((ty :: Type
ty, ann :: Ann
ann) : xs :: [Annotated]
xs) a :: Annotated
a = Type -> Ann -> TypeSig -> TypeSig
Conn Type
ty Ann
ann ([Annotated] -> Annotated -> TypeSig
formArr [Annotated]
xs Annotated
a)
data FunDef
= FunDef
{ FunDef -> Text
name :: Text,
FunDef -> Ann
ann :: Ann,
FunDef -> Constr
constr :: Constr,
FunDef -> Type
res :: Type
}
deriving (Int -> FunDef -> ShowS
[FunDef] -> ShowS
FunDef -> String
(Int -> FunDef -> ShowS)
-> (FunDef -> String) -> ([FunDef] -> ShowS) -> Show FunDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunDef] -> ShowS
$cshowList :: [FunDef] -> ShowS
show :: FunDef -> String
$cshow :: FunDef -> String
showsPrec :: Int -> FunDef -> ShowS
$cshowsPrec :: Int -> FunDef -> ShowS
Show, FunDef -> FunDef -> Bool
(FunDef -> FunDef -> Bool)
-> (FunDef -> FunDef -> Bool) -> Eq FunDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunDef -> FunDef -> Bool
$c/= :: FunDef -> FunDef -> Bool
== :: FunDef -> FunDef -> Bool
$c== :: FunDef -> FunDef -> Bool
Eq, (forall x. FunDef -> Rep FunDef x)
-> (forall x. Rep FunDef x -> FunDef) -> Generic FunDef
forall x. Rep FunDef x -> FunDef
forall x. FunDef -> Rep FunDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunDef x -> FunDef
$cfrom :: forall x. FunDef -> Rep FunDef x
Generic)
getAnn :: Field -> Annotated
getAnn :: Field -> Annotated
getAnn Field {..} = (Type
ty, Ann
ann)
flattenSig :: FunDef -> Doc ann
flattenSig :: FunDef -> Doc ann
flattenSig FunDef {..} =
let n :: Doc ann
n = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines Text
name
doc :: Doc ann
doc = Ann -> Doc ann
forall ann. Ann -> Doc ann
prettyDoc Ann
ann
sig :: Doc ann
sig = TypeSig -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TypeSig -> Doc ann) -> TypeSig -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Annotated] -> Annotated -> TypeSig
formArr ((Field -> Annotated) -> [Field] -> [Annotated]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Annotated
getAnn (Constr -> [Field]
fields Constr
constr)) (Type
res, Ann
forall a. Maybe a
Nothing)
in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ Doc ann
doc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "::",
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 2 "Member TDLib r =>",
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 2 Doc ann
sig
]
vars :: Int -> Doc ann
vars :: Int -> Doc ann
vars i :: Int
i = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Int -> Doc ann) -> [Int] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Doc ann
forall a. IsString a => String -> a
fromString (String -> Doc ann) -> (Int -> String) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [1 .. Int
i]
flattenBody :: FunDef -> Doc ann
flattenBody :: FunDef -> Doc ann
flattenBody FunDef {..} =
let n :: Doc ann
n = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines Text
name
c :: Doc ann
c = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines (Constr
constr Constr -> Getting Text Constr Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Constr Text)
Getting Text Constr Text
#name)
ar :: Int
ar = Constr -> Int
arity Constr
constr
v :: Doc ann
v = Int -> Doc ann
forall ann. Int -> Doc ann
vars Int
ar
in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
n, Doc ann
v, "=", "runCmd $", Doc ann
c, Doc ann
v]
flattenPrint :: FunDef -> Doc ann
flattenPrint :: FunDef -> Doc ann
flattenPrint def :: FunDef
def =
[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ FunDef -> Doc ann
forall ann. FunDef -> Doc ann
flattenSig FunDef
def,
FunDef -> Doc ann
forall ann. FunDef -> Doc ann
flattenBody FunDef
def
]
simplePretty :: FunDef -> Doc ann
simplePretty :: FunDef -> Doc ann
simplePretty FunDef {..} =
let doc :: Doc ann
doc = Ann -> Doc ann
forall ann. Ann -> Doc ann
prettyDoc Ann
ann
n :: Doc ann
n = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines Text
name
cmd :: Doc ann
cmd = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines (Constr
constr Constr -> Getting Text Constr Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Constr Text)
Getting Text Constr Text
#name)
resTy :: Doc ann
resTy = Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
res
in Doc ann
doc
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ Doc ann
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "Member TDLib r" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "=>" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
cmd Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "Sem r (Error ∪ " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
resTy Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ")",
Doc ann
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> "runCmd"
]
instance Pretty FunDef where
pretty :: FunDef -> Doc ann
pretty d :: FunDef
d@FunDef {..} = FunDef -> Doc ann
forall ann. FunDef -> Doc ann
flattenPrint FunDef
d