lcc/exe/load/Main.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 module Main where
   4
   5 import Control.Monad (Monad(..), forM_)
   6 import Data.Either (Either(..))
   7 import Data.Function (($))
   8 import System.IO (IO)
   9 import qualified System.IO as IO
  10 import Text.Show (Show(..))
  11 import qualified Data.Strict as S
  12 import qualified System.Environment as Env
  13 import qualified Text.Megaparsec as P
  14
  15 import qualified Language.Symantic.Document.Term.IO as DocIO
  16
  17 import qualified Hcompta.LCC.Sym as LCC.Sym
  18 import Hcompta.LCC.Read
  19 import Hcompta.LCC.Write as Write
  20
  21 import Prelude (error)
  22
  23 main :: IO ()
  24 main = do
  25         args <- Env.getArgs
  26         forM_ args $ \arg ->
  27                 readLCC @LCC.Sym.SRC arg >>= \case
  28                  Left (Error_Read_Syntax err) ->
  29                         IO.hPutStr IO.stderr $ P.parseErrorPretty err
  30                  Left (Error_Read_Semantic err) -> error $ show err
  31                  Right (r, warns) -> do
  32                         IO.print warns
  33                         -- print r
  34                         DocIO.runTermIO IO.stdout $
  35                                 write (Write.inh, r)
  36
  37
  38 printError :: Show err => Either err a -> IO a
  39 printError (Left err) = error $ show err
  40 printError (Right a)  = return a
  41
  42 printErrorS :: Show err => S.Either err a -> IO a
  43 printErrorS (S.Left err) = error $ show err
  44 printErrorS (S.Right a)  = return a
  45
  46 {-
  47 -- dbg :: Show a => String -> a -> a
  48 -- dbg msg x = trace (msg ++ " = " ++ show x) x
  49 -}