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
(String -> Bool -> Bool -> Int -> CmdArgs)
-> Parser String -> Parser (Bool -> Bool -> Int -> CmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"."
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Output directory of C files")
Parser (Bool -> Bool -> Int -> CmdArgs)
-> Parser Bool -> Parser (Bool -> Int -> CmdArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"justrun" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c'
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Do NOT produce *.c and *.h files as output")
Parser (Bool -> Int -> CmdArgs)
-> Parser Bool -> Parser (Int -> CmdArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Pretty print the specification")
Parser (Int -> CmdArgs) -> Parser Int -> Parser CmdArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"interpret" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
0
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
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 (CmdArgs -> IO ()) -> IO CmdArgs -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParserInfo CmdArgs -> IO CmdArgs
forall a. ParserInfo a -> IO a
execParser ParserInfo CmdArgs
opts where
opts :: ParserInfo CmdArgs
opts = Parser CmdArgs -> InfoMod CmdArgs -> ParserInfo CmdArgs
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser CmdArgs
cmdargs Parser CmdArgs -> Parser (CmdArgs -> CmdArgs) -> Parser CmdArgs
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CmdArgs -> CmdArgs)
forall a. Parser (a -> a)
helper) InfoMod CmdArgs
forall a. InfoMod a
fullDesc
main :: CmdArgs -> IO ()
main :: CmdArgs -> IO ()
main CmdArgs
args = do
let iters :: Int
iters = CmdArgs -> Int
ainterpret CmdArgs
args
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CmdArgs -> Bool
apretty CmdArgs
args) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Printer
pretty Spec
spec
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iters Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Interpreter
interp (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iters) Spec
spec
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CmdArgs -> Bool
acompile CmdArgs
args) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Spec
spec' <- Spec -> IO 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