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"