module Language.Copilot.Main ( copilotMain, defaultMain ) where
import qualified Copilot.Core as C (Spec)
import Copilot.Language (interpret, prettyPrint)
import Copilot.Language.Reify (reify)
import Copilot.Language (Spec)
import Options.Applicative
import Data.Semigroup ((<>))
import Control.Monad (when)
type Interpreter = Integer -> Spec -> IO ()
type Compiler = FilePath -> C.Spec -> IO ()
type Printer = Spec -> IO ()
data CmdArgs = CmdArgs
{ CmdArgs -> String
aoutput :: String
, CmdArgs -> Bool
acompile :: Bool
, CmdArgs -> Bool
apretty :: Bool
, CmdArgs -> Int
ainterpret :: Int
}
cmdargs :: Parser CmdArgs
cmdargs :: Parser CmdArgs
cmdargs = String -> Bool -> Bool -> Int -> CmdArgs
CmdArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"."
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Output directory of C files")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"justrun" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Do NOT produce *.c and *.h files as output")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Pretty print the specification")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"interpret" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
0
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Interpret specification and write result to output")
copilotMain :: Interpreter -> Printer -> Compiler -> Spec -> IO ()
copilotMain :: Interpreter -> Printer -> Compiler -> Printer
copilotMain Interpreter
interp Printer
pretty Compiler
comp Spec
spec = CmdArgs -> IO ()
main forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. ParserInfo a -> IO a
execParser ParserInfo CmdArgs
opts
where
opts :: ParserInfo CmdArgs
opts = forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser CmdArgs
cmdargs forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper) forall a. InfoMod a
fullDesc
main :: CmdArgs -> IO ()
main :: CmdArgs -> IO ()
main CmdArgs
args = do
let iters :: Int
iters = CmdArgs -> Int
ainterpret CmdArgs
args
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CmdArgs -> Bool
apretty CmdArgs
args) forall a b. (a -> b) -> a -> b
$ Printer
pretty Spec
spec
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iters forall a. Ord a => a -> a -> Bool
Prelude.> Int
0) forall a b. (a -> b) -> a -> b
$ Interpreter
interp (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iters) Spec
spec
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CmdArgs -> Bool
acompile CmdArgs
args) forall a b. (a -> b) -> a -> b
$ do
Spec
spec' <- forall a. Spec' a -> IO Spec
reify Spec
spec
Compiler
comp (CmdArgs -> String
aoutput CmdArgs
args) Spec
spec'
defaultMain :: Compiler -> Spec -> IO ()
defaultMain :: Compiler -> Printer
defaultMain = Interpreter -> Printer -> Compiler -> Printer
copilotMain Interpreter
interpret Printer
prettyPrint