module Bludigon.Main.CLI ( launch ) where import Control.DeepSeq import Data.Version (showVersion) import GHC.Generics import System.Console.GetOpt import System.Directory (XdgDirectory (..), createDirectoryIfMissing, doesFileExist, getXdgDirectory) import System.Environment (getArgs, getProgName) import System.Exit (ExitCode (..), exitFailure, exitSuccess) import System.FilePath ((</>)) import System.Info (arch, compilerName, compilerVersion, os) import System.Posix.Process (executeFile) import System.Process (runProcess, waitForProcess) import Paths_bludigon (version) data Flag = Help | Version deriving (Flag -> Flag -> Bool (Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Flag -> Flag -> Bool $c/= :: Flag -> Flag -> Bool == :: Flag -> Flag -> Bool $c== :: Flag -> Flag -> Bool Eq, (forall x. Flag -> Rep Flag x) -> (forall x. Rep Flag x -> Flag) -> Generic Flag forall x. Rep Flag x -> Flag forall x. Flag -> Rep Flag x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Flag x -> Flag $cfrom :: forall x. Flag -> Rep Flag x Generic, Eq Flag Eq Flag -> (Flag -> Flag -> Ordering) -> (Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> (Flag -> Flag -> Flag) -> (Flag -> Flag -> Flag) -> Ord Flag Flag -> Flag -> Bool Flag -> Flag -> Ordering Flag -> Flag -> Flag forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Flag -> Flag -> Flag $cmin :: Flag -> Flag -> Flag max :: Flag -> Flag -> Flag $cmax :: Flag -> Flag -> Flag >= :: Flag -> Flag -> Bool $c>= :: Flag -> Flag -> Bool > :: Flag -> Flag -> Bool $c> :: Flag -> Flag -> Bool <= :: Flag -> Flag -> Bool $c<= :: Flag -> Flag -> Bool < :: Flag -> Flag -> Bool $c< :: Flag -> Flag -> Bool compare :: Flag -> Flag -> Ordering $ccompare :: Flag -> Flag -> Ordering $cp1Ord :: Eq Flag Ord, ReadPrec [Flag] ReadPrec Flag Int -> ReadS Flag ReadS [Flag] (Int -> ReadS Flag) -> ReadS [Flag] -> ReadPrec Flag -> ReadPrec [Flag] -> Read Flag forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Flag] $creadListPrec :: ReadPrec [Flag] readPrec :: ReadPrec Flag $creadPrec :: ReadPrec Flag readList :: ReadS [Flag] $creadList :: ReadS [Flag] readsPrec :: Int -> ReadS Flag $creadsPrec :: Int -> ReadS Flag Read, Int -> Flag -> ShowS [Flag] -> ShowS Flag -> String (Int -> Flag -> ShowS) -> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Flag] -> ShowS $cshowList :: [Flag] -> ShowS show :: Flag -> String $cshow :: Flag -> String showsPrec :: Int -> Flag -> ShowS $cshowsPrec :: Int -> Flag -> ShowS Show) instance NFData Flag options :: [OptDescr Flag] options :: [OptDescr Flag] options = [ String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a Option [Char 'h'] [String "help"] (Flag -> ArgDescr Flag forall a. a -> ArgDescr a NoArg Flag Help) String "Explain CLI usage" , String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a Option [Char 'v'] [String "version"] (Flag -> ArgDescr Flag forall a. a -> ArgDescr a NoArg Flag Version) String "Display version" ] launch :: IO () launch :: IO () launch = do [String] args <- IO [String] getArgs case 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] args of ([Flag] optArgs, [], []) -> [Flag] -> IO () controlOptions [Flag] optArgs ([Flag], [String], [String]) _ -> do IO () printUsage IO () forall a. IO a exitFailure controlOptions :: [Flag] -> IO () controlOptions :: [Flag] -> IO () controlOptions [Flag] flags | Flag Help Flag -> [Flag] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [Flag] flags = do IO () printUsage IO () forall a. IO a exitSuccess | Bool otherwise = case [Flag] flags of [] -> IO () build [Flag Version] -> do IO () printVersion IO () forall a. IO a exitSuccess [Flag] _ -> do IO () printUsage IO () forall a. IO a exitFailure printUsage :: IO () printUsage :: IO () printUsage = String -> IO () putStr (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String -> [OptDescr Flag] -> String forall a. String -> [OptDescr a] -> String usageInfo String header [OptDescr Flag] options where header :: String header = String "Usage: bludigon [OPTIONS]" printVersion :: IO () printVersion :: IO () printVersion = String -> IO () putStrLn (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "bludigon-" String -> ShowS forall a. Semigroup a => a -> a -> a <> Version -> String showVersion Version version String -> ShowS forall a. Semigroup a => a -> a -> a <> String " compiled with " String -> ShowS forall a. Semigroup a => a -> a -> a <> String compiler where compiler :: String compiler = String compilerName String -> ShowS forall a. Semigroup a => a -> a -> a <> String "-" String -> ShowS forall a. Semigroup a => a -> a -> a <> Version -> String showVersion Version compilerVersion getXdgDir :: XdgDirectory -> IO FilePath getXdgDir :: XdgDirectory -> IO String getXdgDir = (XdgDirectory -> String -> IO String) -> String -> XdgDirectory -> IO String forall a b c. (a -> b -> c) -> b -> a -> c flip XdgDirectory -> String -> IO String getXdgDirectory String "bludigon" build :: IO () build :: IO () build = do String configPath <- (String -> ShowS </> String configLeafname) ShowS -> IO String -> IO String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> XdgDirectory -> IO String getXdgDir XdgDirectory XdgConfig Bool configExists <- String -> IO Bool doesFileExist String configPath if Bool configExists then do String progName <- IO String getProgName if String progName String -> String -> Bool forall a. Eq a => a -> a -> Bool == String compiledConfigLeafname then () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () else do IO () compile String cacheDir <- XdgDirectory -> IO String getXdgDir XdgDirectory XdgCache String -> Bool -> [String] -> Maybe [(String, String)] -> IO () forall a. String -> Bool -> [String] -> Maybe [(String, String)] -> IO a executeFile (String cacheDir String -> ShowS </> String compiledConfigLeafname) Bool False [] Maybe [(String, String)] forall a. Maybe a Nothing else () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () compile :: IO () compile :: IO () compile = do String configDir <- XdgDirectory -> IO String getXdgDir XdgDirectory XdgConfig String cacheDir <- XdgDirectory -> IO String getXdgDir XdgDirectory XdgCache Bool -> String -> IO () createDirectoryIfMissing Bool False String cacheDir ExitCode status <- ProcessHandle -> IO ExitCode waitForProcess (ProcessHandle -> IO ExitCode) -> IO ProcessHandle -> IO ExitCode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< String -> [String] -> Maybe String -> Maybe [(String, String)] -> Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ProcessHandle runProcess String "ghc" [ String "--make" , String configLeafname , String "-main-is", String "main" , String "-v0" , String "-o", String cacheDir String -> ShowS </> String compiledConfigLeafname ] (String -> Maybe String forall a. a -> Maybe a Just String configDir) Maybe [(String, String)] forall a. Maybe a Nothing Maybe Handle forall a. Maybe a Nothing Maybe Handle forall a. Maybe a Nothing Maybe Handle forall a. Maybe a Nothing case ExitCode status of ExitCode ExitSuccess -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () ExitFailure Int _ -> IO () forall a. IO a exitFailure compiledConfigLeafname :: FilePath compiledConfigLeafname :: String compiledConfigLeafname = String "bludigon-" String -> ShowS forall a. Semigroup a => a -> a -> a <> String arch String -> ShowS forall a. Semigroup a => a -> a -> a <> String "-" String -> ShowS forall a. Semigroup a => a -> a -> a <> String os configLeafname :: FilePath configLeafname :: String configLeafname = String "bludigon.hs"