quox/exe/Main.idr

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)
-}