Newer
Older
import Colog
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Data.Foldable
import Data.Functor
import Options.Applicative
import System.Directory
import System.Exit
import System.FilePath
import System.IO
import System.Process.Typed
import Text.Pretty.Simple
import Text.PrettyPrint qualified as P
import Prelude hiding (log)
. fold
$ []
process :: (WithLog env (Msg sev) m, MonadIO m) => sev -> Text.Text -> m a -> m a
process sev p ma = do
msg "Started "
a <- ma
msg "Done "
pure a
s = withFrozenCallStack callStack
msg t = Colog.logMsg (Msg sev s (t <> p))
run :: (HasCallStack) => Parser (IO ())
run = do
expmode <-
flag False True
$ fold
[ long "exp"
, help "run in exponential mode"
]
[ long "pedandic"
, short 'P'
, help "when checking for validity, throw error if command fails"
debug <-
flag False True
$ fold
[ long "debug"
, help "enable debugging"
]
cmd <- strArgument $ fold [metavar "COMMAND"]
file <- strArgument $ fold [metavar "FILE"]
pure
$ usingLoggerT (cmap fmtMessage logTextStdout)
$ do
let
test f = process D ("test " <> Text.pack f) do
validiate f = case validity of
Just vcmd -> process D ("validiate " <> Text.pack f) do
err <- liftIO $ runProcess vcmd
log D (Text.pack $ show err)
pure (err == ExitSuccess)
Nothing -> pure True
output f c = process D ("writing " <> Text.pack f) do
let x = P.render (C.pretty (c $> C.undefNode))
liftIO $ writeFile f x
check' f val c = do
logInfo "Checking predictate"
when debug do
copyFile file (file <.> "fail")
copyFile (file <.> "last") file
exitFailure
let bak = file <.> "bak"
process D "backing up file" do
liftIO $ copyFile file bak
process I "validiating" do
v <- validiate file
unless v do
logError "did not validiate program"
liftIO exitFailure
process I "check predicate" do
t <- test file
unless t do
liftIO exitFailure
c <- process D "parsing file" do
parseCFile file
output file c
process I "sanity checks" do
c' <- parseCFile file
unless (void c' == void c) do
liftIO do
withFile "error.1.hs" WriteMode (`pHPrint` void c)
withFile "error.2.hs" WriteMode (`pHPrint` void c')
logError "Outputted a different file than i read... Please report original file and error.{1,2}.hs"
liftIO exitFailure
t <- test file
unless t do
liftIO exitFailure