{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
-- | CLI scaffolding shared by the rwc and rwe drivers.
module Driver (driverMain) where

import ReWire.Config (Config, loadPath, verbose)
import ReWire.Flags (Flag)
import qualified ReWire.Config as Config

import Control.Lens ((^.), over)
import Control.Monad (when)
import Data.List (intercalate)
import Data.Text (Text, pack)
import System.Console.GetOpt (getOpt, usageInfo, OptDescr, ArgOrder (..))
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (stderr)
import qualified Data.Text.IO as T

import Paths_rewire (getDataFileName)

-- | Shared @main@ for the rwc and rwe executables: parse the command line
--   into a Config, extend the loadpath with the bundled rewire-user sources,
--   then run the per-file action.
driverMain :: String -> [OptDescr Flag] -> (Config -> FilePath -> IO ()) -> IO ()
driverMain :: String -> [OptDescr Flag] -> (Config -> String -> IO ()) -> IO ()
driverMain String
prog [OptDescr Flag]
options Config -> String -> IO ()
act = do
      (flags, filenames, errs) <- ArgOrder Flag
-> [OptDescr Flag] -> [String] -> ([Flag], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder Flag
forall a. ArgOrder a
Permute [OptDescr Flag]
options ([String] -> ([Flag], [String], [String]))
-> IO [String] -> IO ([Flag], [String], [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs

      when (not $ null errs) $ exitUsage' (map pack errs)
      when (null filenames)  $ exitUsage' ["No input files"]

      conf     <- either (exitUsage' . pure) pure $ Config.interpret flags
      when (conf^.verbose) $ do
            putStrLn $ "Debug: Flags: " <> show flags
            putStrLn $ "Debug: Source files: " <> show filenames

      systemLP <- getSystemLoadPath
      let conf' = ASetter Config Config [String] [String]
-> ([String] -> [String]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [String] [String]
Lens' Config [String]
loadPath ([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ([String]
systemLP [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"."])) Config
conf

      when (conf'^.verbose) $ putStrLn $ "Debug: loadpath: " <> intercalate "," (conf'^.loadPath)

      mapM_ (act conf') filenames

      where exitUsage :: IO a
            exitUsage :: forall a. IO a
exitUsage = Handle -> Text -> IO ()
T.hPutStr Handle
stderr (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [OptDescr Flag] -> String
forall a. String -> [OptDescr a] -> String
usageInfo (String
"\nUsage: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
prog String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" [OPTION...] <filename.hs>") [OptDescr Flag]
options) IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure

            -- | Print errors, usage, then exit.
            exitUsage' :: [Text] -> IO a
            exitUsage' :: forall a. [Text] -> IO a
exitUsage' [Text]
errs = do
                  (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Text -> IO ()
T.hPutStr Handle
stderr (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") [Text]
errs
                  IO a
forall a. IO a
exitUsage

getSystemLoadPath :: IO [FilePath]
getSystemLoadPath :: IO [String]
getSystemLoadPath = String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getDataFileName (String
"rewire-user" String -> String -> String
</> String
"src")