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