88 lines
2.0 KiB
Idris
88 lines
2.0 KiB
Idris
module Main
|
||
|
||
import Quox.Syntax
|
||
import Quox.Parser
|
||
import Quox.Definition
|
||
import Quox.Pretty
|
||
|
||
import System
|
||
import Data.IORef
|
||
import Data.SortedSet
|
||
import Control.Eff
|
||
|
||
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 ()
|
||
main = do
|
||
seen <- newIORef SortedSet.empty
|
||
defs <- newIORef SortedMap.empty
|
||
suf <- newIORef $ the Nat 0
|
||
for_ (drop 1 !getArgs) $ \file => do
|
||
putStrLn "checking \{file}"
|
||
Right res <- fromParserIO ["."] seen suf defs $ loadProcessFile noLoc file
|
||
| Left err => die $ runPrettyColor $ prettyError True err
|
||
for_ res $ \(name, def) => putDoc $ runPrettyColor $ prettySig name def
|
||
|
||
-----------------------------------
|
||
{-
|
||
|
||
private
|
||
text : PrettyOpts -> List String
|
||
text _ =
|
||
["",
|
||
#" ___ ___ _____ __ __"#,
|
||
#"/ _ `/ // / _ \\ \ /"#,
|
||
#"\_, /\_,_/\___/_\_\"#,
|
||
#" /_/"#,
|
||
""]
|
||
|
||
private
|
||
qtuwu : PrettyOpts -> List String
|
||
qtuwu opts =
|
||
if opts.unicode then
|
||
[#" ___,-´⎠ "#,
|
||
#"(·`──´ ◡ -´⎠"#,
|
||
#" \/\/──´⎞/`──´ "#,
|
||
#" ⎜⎟───,-₎ ⎞ "#,
|
||
#" ⎝⎠ (‾‾) ⎟ "#,
|
||
#" (‾‾‾) ⎟ "#]
|
||
else
|
||
[#" ___,-´/ "#,
|
||
#"(.`--´ u -´/"#,
|
||
#" \/\/--´|/`--´ "#,
|
||
#" ||---,-, \ "#,
|
||
#" `´ (--) | "#,
|
||
#" (---) | "#]
|
||
|
||
private
|
||
join1 : PrettyOpts -> String -> String -> String
|
||
join1 opts l r =
|
||
if opts.color then
|
||
" " <+> show (colored Green l) <+> " " <+> show (colored Magenta r)
|
||
else
|
||
" " <+> l <+> " " <+> r
|
||
|
||
export
|
||
banner : PrettyOpts -> String
|
||
banner opts = unlines $ zipWith (join1 opts) (qtuwu opts) (text opts)
|
||
-}
|