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