module IR.Constraint.PrettyPrint (
  printConstraint,
  Doc,
) where

import qualified Common.Identifiers as Ident
import qualified IR.Constraint.Canonical as Can
import IR.Constraint.Type as Typ (
  Constraint (
    CAnd,
    CEqual,
    CForeign,
    CLet,
    CLocal,
    CPattern,
    CSaveTheEnvironment,
    CTrue
  ),
  Type (..),
  Variable,
  toCanType,
 )

import Prettyprinter

import Data.Map as Map (Map, null, toList)

import IR.Constraint.Monad (TC)


-- Make Constraint an instance of Pretty!!!

-- Has to operate inside TC monad to invoke toCanType!!!

-- data Constraint
--   = CTrue
--   | CSaveTheEnvironment
--   | CEqual Type Type
--   | CPattern Type Type
--   | CLocal Ident.Identifier Type
--   | CForeign Can.Scheme Type
--   | CAnd [Constraint]
--   | CLet { _rigidVars :: [Variable]
--          , _flexVars :: [Variable]
--          , _header :: Map.Map Ident.Identifier Type
--          , _headerCon :: Constraint
--          , _bodyCon :: Constraint
--          }

indentation :: Doc ann -> Doc ann
indentation :: Doc ann -> Doc ann
indentation = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2


printConstraint :: Constraint -> TC (Doc ann)
printConstraint :: Constraint -> TC (Doc ann)
printConstraint Constraint
CTrue = do
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"true"
printConstraint Constraint
CSaveTheEnvironment = do
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"SaveTheEnvironment"
printConstraint (CEqual Type
t1 Type
t2) = do
  Doc ann
p1 <- Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printType Type
t1
  Doc ann
p2 <- Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printType Type
t2
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep) [Doc ann
p1, [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"=", Doc ann
p2]
printConstraint (CPattern Type
t1 Type
t2) = do
  Doc ann
p1 <- Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printType Type
t1
  Doc ann
p2 <- Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printType Type
t2
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep) [Doc ann
p1, [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"=p", Doc ann
p2]
printConstraint (CLocal Identifier
i Type
t) = do
  Doc ann
p <- Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printType Type
t
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"local" 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 -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep) [([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann)
-> (Identifier -> [Char]) -> Identifier -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> [Char]
forall a. Show a => a -> [Char]
show) Identifier
i, [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"<:", Doc ann
p]
printConstraint (CForeign (Can.Forall FreeVars
vars Type
ct) Type
t) = do
  Doc ann
pct <- Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printCanType Type
ct
  let scheme :: Doc ann
scheme = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"forall" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> (FreeVars -> [Char]) -> FreeVars -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TVarId, ())] -> [Char]
forall a. Show a => a -> [Char]
show ([(TVarId, ())] -> [Char])
-> (FreeVars -> [(TVarId, ())]) -> FreeVars -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeVars -> [(TVarId, ())]
forall k a. Map k a -> [(k, a)]
toList) FreeVars
vars Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
dot Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
pct

  Doc ann
p <- Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printType Type
t
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"foreign" 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 -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep) [Doc ann
scheme, [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"<:", Doc ann
p]
printConstraint (CAnd [Constraint]
lst) = do
  [Doc ann]
printed <- (Constraint -> TC (Doc ann))
-> [Constraint]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint [Constraint]
lst
  let joined :: Doc ann
joined = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
printed
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc ann
joined
printConstraint (CLet [Variable]
_ [Variable
v] Map Identifier Type
h (CAnd ((CEqual (TVarN Variable
v') Type
_) : [Constraint]
xs)) Constraint
CTrue) | Map Identifier Type -> Bool
forall k a. Map k a -> Bool
Map.null Map Identifier Type
h Bool -> Bool -> Bool
&& Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
v' = do
  Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint ([Constraint] -> Constraint
CAnd [Constraint]
xs)
printConstraint (CLet [Variable]
r [Variable]
f Map Identifier Type
h Constraint
hc Constraint
CTrue) | Map Identifier Type -> Bool
forall k a. Map k a -> Bool
Map.null Map Identifier Type
h = do
  [Doc ann]
pr <- (Variable -> TC (Doc ann))
-> [Variable]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Variable -> TC (Doc ann)
forall ann. Variable -> TC (Doc ann)
printVar [Variable]
r
  [Doc ann]
pf <- (Variable -> TC (Doc ann))
-> [Variable]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Variable -> TC (Doc ann)
forall ann. Variable -> TC (Doc ann)
printVar [Variable]
f

  Doc ann
phc <- Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint Constraint
hc

  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$
    (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep)
      [ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"exists" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ([Doc ann]
pf [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann]
pr)
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation
          ( Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
phc
          )
      ]
printConstraint (CLet [] [] Map Identifier Type
h Constraint
CTrue Constraint
bc) = do
  Doc ann
pheader <- Map Identifier Type -> TC (Doc ann)
forall ann. Map Identifier Type -> TC (Doc ann)
printHeader Map Identifier Type
h
  Doc ann
pbc <- Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint Constraint
bc

  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$
    (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep)
      [ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"def"
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation
          ( Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
pheader
          )
      , [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"in"
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation Doc ann
pbc
      ]
printConstraint (CLet [Variable]
r [Variable]
f Map Identifier Type
o (CLet [] [] Map Identifier Type
i Constraint
CTrue Constraint
innerbc) Constraint
bc) | Map Identifier Type
o Map Identifier Type -> Map Identifier Type -> Bool
forall a. Eq a => a -> a -> Bool
== Map Identifier Type
i = do
  [Doc ann]
pr <- (Variable -> TC (Doc ann))
-> [Variable]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Variable -> TC (Doc ann)
forall ann. Variable -> TC (Doc ann)
printVar [Variable]
r
  [Doc ann]
pf <- (Variable -> TC (Doc ann))
-> [Variable]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Variable -> TC (Doc ann)
forall ann. Variable -> TC (Doc ann)
printVar [Variable]
f

  Doc ann
pheader <- Map Identifier Type -> TC (Doc ann)
forall ann. Map Identifier Type -> TC (Doc ann)
printHeader Map Identifier Type
o

  Doc ann
pbc <- Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint Constraint
bc

  Doc ann
pinnerbc <- Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint Constraint
innerbc

  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$
    (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep)
      [ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"let rec" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ([Doc ann]
pf [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann]
pr)
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation
          ( Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
pheader
          )
      , [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"given"
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation Doc ann
pinnerbc
      , [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"in"
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation Doc ann
pbc
      ]
printConstraint (CLet [Variable]
r [Variable]
f Map Identifier Type
h Constraint
hc Constraint
bc) = do
  [Doc ann]
pr <- (Variable -> TC (Doc ann))
-> [Variable]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Variable -> TC (Doc ann)
forall ann. Variable -> TC (Doc ann)
printVar [Variable]
r
  [Doc ann]
pf <- (Variable -> TC (Doc ann))
-> [Variable]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Variable -> TC (Doc ann)
forall ann. Variable -> TC (Doc ann)
printVar [Variable]
f

  Doc ann
pheader <- Map Identifier Type -> TC (Doc ann)
forall ann. Map Identifier Type -> TC (Doc ann)
printHeader Map Identifier Type
h

  Doc ann
phc <- Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint Constraint
hc
  Doc ann
pbc <- Constraint -> TC (Doc ann)
forall ann. Constraint -> TC (Doc ann)
printConstraint Constraint
bc

  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$
    (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep)
      [ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ([Doc ann]
pf [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann]
pr)
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation
          ( Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
pheader
          )
      , [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"given"
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation
          ( Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
phc
          )
      , [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"in"
      , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
indentation Doc ann
pbc
      ]


printType :: Typ.Type -> TC (Doc ann)
printType :: Type -> TC (Doc ann)
printType (TConN TConId
i [Type]
lst) = do
  [Doc ann]
printed <- (Type -> TC (Doc ann))
-> [Type]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printType [Type]
lst
  if TConId -> [Char]
forall a. Show a => a -> [Char]
show TConId
i [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"->"
    then let [Doc ann
a, Doc ann
b] = [Doc ann]
printed in Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
a Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
b
    else Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ TConId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TConId
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann]
printed
printType (TVarN Variable
var) = do Variable -> TC (Doc ann)
forall ann. Variable -> TC (Doc ann)
printVar Variable
var


printVar :: Variable -> TC (Doc ann)
printVar :: Variable -> TC (Doc ann)
printVar Variable
var = do
  Type
can_t <- Variable -> TC Type
toCanType Variable
var
  Type -> TC (Doc ann)
forall ann. Type -> TC (Doc ann)
printCanType Type
can_t


printCanType :: Can.Type -> TC (Doc ann)
printCanType :: Type -> TC (Doc ann)
printCanType Type
t = do Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ Type -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type
t


printHeader :: Map.Map Ident.Identifier Type -> TC (Doc ann)
printHeader :: Map Identifier Type -> TC (Doc ann)
printHeader Map Identifier Type
headers = do
  [Doc ann]
lst <- ((Identifier, Type) -> TC (Doc ann))
-> [(Identifier, Type)]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Identifier, Type) -> TC (Doc ann)
forall a ann.
Show a =>
(a, Type)
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) (Doc ann)
printPair ([(Identifier, Type)]
 -> StateT
      TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann])
-> [(Identifier, Type)]
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) [Doc ann]
forall a b. (a -> b) -> a -> b
$ Map Identifier Type -> [(Identifier, Type)]
forall k a. Map k a -> [(k, a)]
toList Map Identifier Type
headers
  Doc ann -> TC (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> TC (Doc ann)) -> Doc ann -> TC (Doc ann)
forall a b. (a -> b) -> a -> b
$ (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep) [Doc ann]
lst
 where
  printPair :: (a, Type)
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) (Doc ann)
printPair (a
i, Type
t) = do
    Doc ann
pt <- Type
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) (Doc ann)
forall ann. Type -> TC (Doc ann)
printType Type
t
    Doc ann
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann
 -> StateT
      TCState (ExceptT Error (WriterT (Doc [Char]) IO)) (Doc ann))
-> Doc ann
-> StateT
     TCState (ExceptT Error (WriterT (Doc [Char]) IO)) (Doc ann)
forall a b. (a -> b) -> a -> b
$ ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> (a -> [Char]) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show) a
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
pt