rewrite pretty printer

exe/Main.idr

@@ -9,11 +9,26 @@ import System
 import Data.IORef
 import Data.SortedSet
 import Control.Eff
-import Text.PrettyPrint.Prettyprinter.Render.Terminal
 
-export
-die : Doc HL -> IO a
-die err = do putDoc $ termHL <$> err; exitFailure
+private
+Opts : LayoutOpts
+Opts = Opts 80
+
+private
+putDoc : Doc Opts -> IO ()
+putDoc = putStr . render Opts
+
+private
+die : Doc Opts -> IO a
+die err = do putDoc err; exitFailure
+
+private
+prettySig : {opts : _} -> Name -> Definition -> Eff Pretty (Doc opts)
+prettySig name def = do
+  qty  <- prettyQty def.qty.fst
+  name <- prettyFree name
+  type <- prettyTerm [<] [<] def.type
+  hangDSingle (hsep [hcat [qty, !dotD, name], !colonD]) type
 
 export
 main : IO ()
@@ -24,15 +39,11 @@ main = do
   for_ (drop 1 !getArgs) $ \file => do
     putStrLn "checking \{file}"
     Right res <- fromParserIO ["."] seen suf defs $ loadProcessFile noLoc file
-      | Left err => die $ prettyError True True err
-    for_ res $ \(name, def) => do
-      putDoc $ map termHL $ nest 2 $
-        sep [hsep [hcat [pretty0 True def.qty.fst, dotD,
-                         hl Free (pretty0 True name)],
-                   colonD],
-             prettyTerm True [<] [<] def.type]
+      | Left err => die $ runPrettyColor $ prettyError True err
+    for_ res $ \(name, def) => putDoc $ runPrettyColor $ prettySig name def
 
 -----------------------------------
+{-
 
 private
 text : PrettyOpts -> List String
@@ -73,3 +84,4 @@ join1 opts l r =
 export
 banner : PrettyOpts -> String
 banner opts = unlines $ zipWith (join1 opts) (qtuwu opts) (text opts)
+-}