{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}

-- | Command-line interface for gimlc
module Language.Giml.Compiler.Run where

import Control.Monad.Except
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Language.Giml qualified as Giml
import Language.Giml.Compiler.Compile
import Language.Giml.Compiler.REPL
import Language.Giml.Utils
import Options.Generic
import System.Exit
import System.IO

-- | gimlc cli interface type
data Command w
  = Compile
      { forall w. Command w -> w ::: (FilePath <?> "input file")
input :: w ::: FilePath <?> "input file"
      , forall w. Command w -> w ::: (Maybe FilePath <?> "output file")
output :: w ::: Maybe FilePath <?> "output file"
      , forall w. Command w -> w ::: (Bool <?> "emit warnings")
warn :: w ::: Bool <?> "emit warnings"
      }
  | Parse
      { input :: w ::: FilePath <?> "input file"
      , output :: w ::: Maybe FilePath <?> "output file"
      }
  | Infer
      { input :: w ::: FilePath <?> "input file"
      , output :: w ::: Maybe FilePath <?> "output file"
      , warn :: w ::: Bool <?> "emit warnings"
      }
  | Interactive
      { forall w. Command w -> w ::: (Maybe FilePath <?> "input file")
load :: w ::: Maybe FilePath <?> "input file"
      }
  deriving ((forall x. Command w -> Rep (Command w) x)
-> (forall x. Rep (Command w) x -> Command w)
-> Generic (Command w)
forall x. Rep (Command w) x -> Command w
forall x. Command w -> Rep (Command w) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w x. Rep (Command w) x -> Command w
forall w x. Command w -> Rep (Command w) x
$cto :: forall w x. Rep (Command w) x -> Command w
$cfrom :: forall w x. Command w -> Rep (Command w) x
Generic)

instance ParseRecord (Command Wrapped)

deriving instance Show (Command Unwrapped)

-- | Reads command-line arguments and acts accordingly
run :: IO ()
run :: IO ()
run = do
  Command Unwrapped
arguments <- Text -> IO (Command Unwrapped)
forall (io :: * -> *) (f :: * -> *).
(Functor io, MonadIO io, ParseRecord (f Wrapped), Unwrappable f) =>
Text -> io (f Unwrapped)
unwrapRecord Text
"gimlc"
  case Command Unwrapped
arguments of
    Compile Unwrapped ::: (FilePath <?> "input file")
inputFile Unwrapped ::: (Maybe FilePath <?> "output file")
outputFile Unwrapped ::: (Bool <?> "emit warnings")
w -> do
      (FilePath -> Text -> IO (Either Text Text))
-> FilePath -> Maybe FilePath -> IO ()
process
        (LogAction IO LogMsg -> FilePath -> Text -> IO (Either Text Text)
forall (b :: * -> *).
MonadBase b b =>
LogAction b LogMsg -> FilePath -> Text -> b (Either Text Text)
compile (LogAction IO LogMsg -> FilePath -> Text -> IO (Either Text Text))
-> LogAction IO LogMsg -> FilePath -> Text -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Verbosity -> LogAction IO LogMsg
logact FilePath
Unwrapped ::: (FilePath <?> "input file")
inputFile (if Bool
Unwrapped ::: (Bool <?> "emit warnings")
w then Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just Verbosity
Giml.Warning else Maybe Verbosity
forall a. Maybe a
Nothing))
        FilePath
Unwrapped ::: (FilePath <?> "input file")
inputFile
        Maybe FilePath
Unwrapped ::: (Maybe FilePath <?> "output file")
outputFile
    Parse Unwrapped ::: (FilePath <?> "input file")
inputFile Unwrapped ::: (Maybe FilePath <?> "output file")
outputFile -> do
      (FilePath -> Text -> IO (Either Text Text))
-> FilePath -> Maybe FilePath -> IO ()
process
        ( \FilePath
i Text
o ->
            Either Text Text -> IO (Either Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (Either Text Text -> IO (Either Text Text))
-> (ExceptT
      Text
      (ReaderT (CompileInfo Identity) Identity)
      (ParsedFile SourcePos)
    -> Either Text Text)
-> ExceptT
     Text
     (ReaderT (CompileInfo Identity) Identity)
     (ParsedFile SourcePos)
-> IO (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedFile SourcePos -> Text)
-> Either Text (ParsedFile SourcePos) -> Either Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedFile SourcePos -> Text
forall a. Show a => a -> Text
pShow
              (Either Text (ParsedFile SourcePos) -> Either Text Text)
-> (ExceptT
      Text
      (ReaderT (CompileInfo Identity) Identity)
      (ParsedFile SourcePos)
    -> Either Text (ParsedFile SourcePos))
-> ExceptT
     Text
     (ReaderT (CompileInfo Identity) Identity)
     (ParsedFile SourcePos)
-> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  Text
  (ReaderT (CompileInfo Identity) Identity)
  (ParsedFile SourcePos)
-> Either Text (ParsedFile SourcePos)
forall e a.
ExceptT e (ReaderT (CompileInfo Identity) Identity) a -> Either e a
Giml.runWithoutLogger
              (ExceptT
   Text
   (ReaderT (CompileInfo Identity) Identity)
   (ParsedFile SourcePos)
 -> IO (Either Text Text))
-> ExceptT
     Text
     (ReaderT (CompileInfo Identity) Identity)
     (ParsedFile SourcePos)
-> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ FilePath
-> Text
-> ExceptT
     Text
     (ReaderT (CompileInfo Identity) Identity)
     (ParsedFile SourcePos)
forall env (b :: * -> *) (m :: * -> *).
CompilePhase Text env b m =>
FilePath -> Text -> m (ParsedFile SourcePos)
Giml.parse FilePath
i Text
o
        )
        FilePath
Unwrapped ::: (FilePath <?> "input file")
inputFile
        Maybe FilePath
Unwrapped ::: (Maybe FilePath <?> "output file")
outputFile
    Infer Unwrapped ::: (FilePath <?> "input file")
inputFile Unwrapped ::: (Maybe FilePath <?> "output file")
outputFile Unwrapped ::: (Bool <?> "emit warnings")
w -> do
      (FilePath -> Text -> IO (Either Text Text))
-> FilePath -> Maybe FilePath -> IO ()
process
        ( \FilePath
i Text
o -> do
            ExceptT Text IO Text -> IO (Either Text Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO Text -> IO (Either Text Text))
-> (ExceptT Text IO (File Ann) -> ExceptT Text IO Text)
-> ExceptT Text IO (File Ann)
-> IO (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (File Ann -> Text)
-> ExceptT Text IO (File Ann) -> ExceptT Text IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (File Text -> Text
forall a. Show a => a -> Text
pShow (File Text -> Text) -> (File Ann -> File Text) -> File Ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> Text) -> File Ann -> File Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ann -> Text
Giml.printAnn) (ExceptT Text IO (File Ann) -> IO (Either Text Text))
-> ExceptT Text IO (File Ann) -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$
              LogAction IO LogMsg
-> FilePath -> Text -> ExceptT Text IO (File Ann)
forall (b :: * -> *).
MonadBase b b =>
LogAction b LogMsg -> FilePath -> Text -> ExceptT Text b (File Ann)
Giml.parseInferPipeline (FilePath -> Maybe Verbosity -> LogAction IO LogMsg
logact FilePath
i (Maybe Verbosity -> LogAction IO LogMsg)
-> Maybe Verbosity -> LogAction IO LogMsg
forall a b. (a -> b) -> a -> b
$ if Bool
Unwrapped ::: (Bool <?> "emit warnings")
w then Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just Verbosity
Giml.Warning else Maybe Verbosity
forall a. Maybe a
Nothing) FilePath
i Text
o
        )
        FilePath
Unwrapped ::: (FilePath <?> "input file")
inputFile
        Maybe FilePath
Unwrapped ::: (Maybe FilePath <?> "output file")
outputFile
    Interactive Unwrapped ::: (Maybe FilePath <?> "input file")
mInputFile -> do
      Maybe FilePath -> IO ()
runRepl Maybe FilePath
Unwrapped ::: (Maybe FilePath <?> "input file")
mInputFile

logact :: FilePath -> Maybe Giml.Verbosity -> Giml.LogAction IO Giml.LogMsg
logact :: FilePath -> Maybe Verbosity -> LogAction IO LogMsg
logact FilePath
i =
  LogAction IO LogMsg
-> (Verbosity -> LogAction IO LogMsg)
-> Maybe Verbosity
-> LogAction IO LogMsg
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    LogAction IO LogMsg
Giml.noLoggingIO
    (CompileInfo IO -> LogAction IO LogMsg
forall (m :: * -> *). CompileInfo m -> LogAction m LogMsg
Giml.logAction (CompileInfo IO -> LogAction IO LogMsg)
-> (Verbosity -> CompileInfo IO)
-> Verbosity
-> LogAction IO LogMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Verbosity -> FilePath -> CompileInfo IO)
-> FilePath -> Verbosity -> CompileInfo IO
forall a b c. (a -> b -> c) -> b -> a -> c
flip Verbosity -> FilePath -> CompileInfo IO
Giml.mkCompileInfoIO FilePath
i)

-- | Takes a processing function, an input file and optionally an output file
process
  :: (FilePath -> T.Text -> IO (Either T.Text T.Text))
  -> FilePath
  -> Maybe FilePath
  -> IO ()
process :: (FilePath -> Text -> IO (Either Text Text))
-> FilePath -> Maybe FilePath -> IO ()
process FilePath -> Text -> IO (Either Text Text)
func FilePath
inputFile Maybe FilePath
outputFile = do
  Text
file <- FilePath -> IO Text
T.readFile FilePath
inputFile
  Either Text Text
result <- FilePath -> Text -> IO (Either Text Text)
func FilePath
inputFile Text
file
  case Either Text Text
result of
    Left Text
err -> do
      Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
err
      IO ()
forall a. IO a
exitFailure
    Right Text
prog -> do
      (Text -> IO ())
-> (FilePath -> Text -> IO ()) -> Maybe FilePath -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
T.putStrLn FilePath -> Text -> IO ()
T.writeFile Maybe FilePath
outputFile Text
prog