quox/exe/Main.idr

88 lines
2 KiB
Idris
Raw Normal View History

2022-04-27 14:04:03 -04:00
module Main
2021-07-07 07:11:39 -04:00
2023-03-31 13:31:29 -04:00
import Quox.Syntax
import Quox.Parser
import Quox.Definition
import Quox.Pretty
2021-07-20 16:05:19 -04:00
2023-03-31 13:31:29 -04:00
import System
import Data.IORef
import Data.SortedSet
import Control.Eff
2021-07-20 16:05:19 -04:00
2023-05-14 13:58:46 -04:00
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
2023-03-31 13:31:29 -04:00
export
main : IO ()
main = do
seen <- newIORef SortedSet.empty
defs <- newIORef SortedMap.empty
2023-05-01 21:06:25 -04:00
suf <- newIORef $ the Nat 0
2023-03-31 13:31:29 -04:00
for_ (drop 1 !getArgs) $ \file => do
putStrLn "checking \{file}"
2023-05-01 21:06:25 -04:00
Right res <- fromParserIO ["."] seen suf defs $ loadProcessFile noLoc file
2023-05-14 13:58:46 -04:00
| Left err => die $ runPrettyColor $ prettyError True err
for_ res $ \(name, def) => putDoc $ runPrettyColor $ prettySig name def
2023-03-31 13:31:29 -04:00
-----------------------------------
2023-05-14 13:58:46 -04:00
{-
2021-07-20 16:05:19 -04:00
2022-04-11 08:09:37 -04:00
private
2022-04-11 15:58:33 -04:00
text : PrettyOpts -> List String
2022-04-11 08:09:37 -04:00
text _ =
["",
#" ___ ___ _____ __ __"#,
#"/ _ `/ // / _ \\ \ /"#,
#"\_, /\_,_/\___/_\_\"#,
#" /_/"#,
""]
2022-03-06 19:19:26 -05:00
2022-04-11 08:09:37 -04:00
private
2022-04-11 15:58:33 -04:00
qtuwu : PrettyOpts -> List String
2022-04-11 08:09:37 -04:00
qtuwu opts =
if opts.unicode then
[#" ___,-´⎠ "#,
#"(·`──´ ◡ -´⎠"#,
2023-02-26 04:58:47 -05:00
#" \/\/──´⎞/`──´ "#,
#" ⎜⎟───,-₎ ⎞ "#,
#" ⎝⎠ (‾‾) ⎟ "#,
2022-04-11 08:09:37 -04:00
#" (‾‾‾) ⎟ "#]
else
[#" ___,-´/ "#,
#"(.`--´ u -´/"#,
#" \/\/--´|/`--´ "#,
2023-02-26 04:58:47 -05:00
#" ||---,-, \ "#,
#" `´ (--) | "#,
2022-04-11 08:09:37 -04:00
#" (---) | "#]
private
2022-04-11 15:58:33 -04:00
join1 : PrettyOpts -> String -> String -> String
2022-04-11 08:09:37 -04:00
join1 opts l r =
if opts.color then
" " <+> show (colored Green l) <+> " " <+> show (colored Magenta r)
else
" " <+> l <+> " " <+> r
export
2022-04-11 15:58:33 -04:00
banner : PrettyOpts -> String
2022-04-11 08:09:37 -04:00
banner opts = unlines $ zipWith (join1 opts) (qtuwu opts) (text opts)
2023-05-14 13:58:46 -04:00
-}