{-# LANGUAGE LambdaCase #-}
module Hpack.Options where

import           Imports

import           Data.Maybe
import           System.FilePath
import           System.Directory

data ParseResult = Help | PrintVersion | PrintNumericVersion | Run ParseOptions | ParseError
  deriving (ParseResult -> ParseResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseResult -> ParseResult -> Bool
$c/= :: ParseResult -> ParseResult -> Bool
== :: ParseResult -> ParseResult -> Bool
$c== :: ParseResult -> ParseResult -> Bool
Eq, Int -> ParseResult -> ShowS
[ParseResult] -> ShowS
ParseResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseResult] -> ShowS
$cshowList :: [ParseResult] -> ShowS
show :: ParseResult -> String
$cshow :: ParseResult -> String
showsPrec :: Int -> ParseResult -> ShowS
$cshowsPrec :: Int -> ParseResult -> ShowS
Show)

data Verbose = Verbose | NoVerbose
  deriving (Verbose -> Verbose -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbose -> Verbose -> Bool
$c/= :: Verbose -> Verbose -> Bool
== :: Verbose -> Verbose -> Bool
$c== :: Verbose -> Verbose -> Bool
Eq, Int -> Verbose -> ShowS
[Verbose] -> ShowS
Verbose -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbose] -> ShowS
$cshowList :: [Verbose] -> ShowS
show :: Verbose -> String
$cshow :: Verbose -> String
showsPrec :: Int -> Verbose -> ShowS
$cshowsPrec :: Int -> Verbose -> ShowS
Show)

data Force = Force | NoForce
  deriving (Force -> Force -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Force -> Force -> Bool
$c/= :: Force -> Force -> Bool
== :: Force -> Force -> Bool
$c== :: Force -> Force -> Bool
Eq, Int -> Force -> ShowS
[Force] -> ShowS
Force -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Force] -> ShowS
$cshowList :: [Force] -> ShowS
show :: Force -> String
$cshow :: Force -> String
showsPrec :: Int -> Force -> ShowS
$cshowsPrec :: Int -> Force -> ShowS
Show)

data ParseOptions = ParseOptions {
  ParseOptions -> Verbose
parseOptionsVerbose :: Verbose
, ParseOptions -> Force
parseOptionsForce :: Force
, ParseOptions -> Maybe Bool
parseOptionsHash :: Maybe Bool
, ParseOptions -> Bool
parseOptionsToStdout :: Bool
, ParseOptions -> String
parseOptionsTarget :: FilePath
} deriving (ParseOptions -> ParseOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseOptions -> ParseOptions -> Bool
$c/= :: ParseOptions -> ParseOptions -> Bool
== :: ParseOptions -> ParseOptions -> Bool
$c== :: ParseOptions -> ParseOptions -> Bool
Eq, Int -> ParseOptions -> ShowS
[ParseOptions] -> ShowS
ParseOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseOptions] -> ShowS
$cshowList :: [ParseOptions] -> ShowS
show :: ParseOptions -> String
$cshow :: ParseOptions -> String
showsPrec :: Int -> ParseOptions -> ShowS
$cshowsPrec :: Int -> ParseOptions -> ShowS
Show)

parseOptions :: FilePath -> [String] -> IO ParseResult
parseOptions :: String -> [String] -> IO ParseResult
parseOptions String
defaultTarget = \ case
  [String
"--version"] -> forall (m :: * -> *) a. Monad m => a -> m a
return ParseResult
PrintVersion
  [String
"--numeric-version"] -> forall (m :: * -> *) a. Monad m => a -> m a
return ParseResult
PrintNumericVersion
  [String
"--help"] -> forall (m :: * -> *) a. Monad m => a -> m a
return ParseResult
Help
  [String]
args -> case Either ParseResult (Maybe String, Bool)
targets of
    Right (Maybe String
target, Bool
toStdout) -> do
      String
file <- String -> Maybe String -> IO String
expandTarget String
defaultTarget Maybe String
target
      let
        options :: ParseOptions
options
          | Bool
toStdout = Verbose -> Force -> Maybe Bool -> Bool -> String -> ParseOptions
ParseOptions Verbose
NoVerbose Force
Force Maybe Bool
hash Bool
toStdout String
file
          | Bool
otherwise = Verbose -> Force -> Maybe Bool -> Bool -> String -> ParseOptions
ParseOptions Verbose
verbose Force
force Maybe Bool
hash Bool
toStdout String
file
      forall (m :: * -> *) a. Monad m => a -> m a
return (ParseOptions -> ParseResult
Run ParseOptions
options)
    Left ParseResult
err -> forall (m :: * -> *) a. Monad m => a -> m a
return ParseResult
err
    where
      silentFlag :: String
silentFlag = String
"--silent"
      forceFlags :: [String]
forceFlags = [String
"--force", String
"-f"]
      hashFlag :: String
hashFlag = String
"--hash"
      noHashFlag :: String
noHashFlag = String
"--no-hash"

      flags :: [String]
flags = String
hashFlag forall a. a -> [a] -> [a]
: String
noHashFlag forall a. a -> [a] -> [a]
: String
silentFlag forall a. a -> [a] -> [a]
: [String]
forceFlags

      verbose :: Verbose
      verbose :: Verbose
verbose = if String
silentFlag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args then Verbose
NoVerbose else Verbose
Verbose

      force :: Force
      force :: Force
force = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args) [String]
forceFlags then Force
Force else Force
NoForce

      hash :: Maybe Bool
      hash :: Maybe Bool
hash = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Bool
parse [String]
args
        where
          parse :: String -> Maybe Bool
          parse :: String -> Maybe Bool
parse String
t = Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
t forall a. Eq a => a -> a -> Bool
== String
hashFlag) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
t forall a. Eq a => a -> a -> Bool
== String
noHashFlag)

      ys :: [String]
ys = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
flags) [String]
args

      targets :: Either ParseResult (Maybe FilePath, Bool)
      targets :: Either ParseResult (Maybe String, Bool)
targets = case [String]
ys of
        [String
"-"] -> forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing, Bool
True)
        [String
"-", String
"-"] -> forall a b. a -> Either a b
Left ParseResult
ParseError
        [String
path] -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just String
path, Bool
False)
        [String
path, String
"-"] -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just String
path, Bool
True)
        [] -> forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing, Bool
False)
        [String]
_ -> forall a b. a -> Either a b
Left ParseResult
ParseError

expandTarget :: FilePath -> Maybe FilePath -> IO FilePath
expandTarget :: String -> Maybe String -> IO String
expandTarget String
defaultTarget = \ case
  Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return String
defaultTarget
  Just String
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return String
defaultTarget
  Just String
target -> do
    Bool
isFile <- String -> IO Bool
doesFileExist String
target
    Bool
isDirectory <- String -> IO Bool
doesDirectoryExist String
target
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case ShowS
takeFileName String
target of
      String
_ | Bool
isFile -> String
target
      String
_ | Bool
isDirectory -> String
target String -> ShowS
</> String
defaultTarget
      String
"" -> String
target String -> ShowS
</> String
defaultTarget
      String
_ -> String
target