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

import           Control.Applicative
import           Control.Monad
import           Data.Maybe
import           System.FilePath
import           System.Directory

data ParseResult = Help | PrintVersion | PrintNumericVersion | Run ParseOptions | ParseError
  deriving (ParseResult -> ParseResult -> Bool
(ParseResult -> ParseResult -> Bool)
-> (ParseResult -> ParseResult -> Bool) -> Eq ParseResult
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
(Int -> ParseResult -> ShowS)
-> (ParseResult -> String)
-> ([ParseResult] -> ShowS)
-> Show ParseResult
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
(Verbose -> Verbose -> Bool)
-> (Verbose -> Verbose -> Bool) -> Eq Verbose
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
(Int -> Verbose -> ShowS)
-> (Verbose -> String) -> ([Verbose] -> ShowS) -> Show Verbose
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
(Force -> Force -> Bool) -> (Force -> Force -> Bool) -> Eq Force
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
(Int -> Force -> ShowS)
-> (Force -> String) -> ([Force] -> ShowS) -> Show Force
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
(ParseOptions -> ParseOptions -> Bool)
-> (ParseOptions -> ParseOptions -> Bool) -> Eq ParseOptions
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
(Int -> ParseOptions -> ShowS)
-> (ParseOptions -> String)
-> ([ParseOptions] -> ShowS)
-> Show ParseOptions
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"] -> ParseResult -> IO ParseResult
forall (m :: * -> *) a. Monad m => a -> m a
return ParseResult
PrintVersion
  [String
"--numeric-version"] -> ParseResult -> IO ParseResult
forall (m :: * -> *) a. Monad m => a -> m a
return ParseResult
PrintNumericVersion
  [String
"--help"] -> ParseResult -> IO ParseResult
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
      ParseResult -> IO ParseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseOptions -> ParseResult
Run ParseOptions
options)
    Left ParseResult
err -> ParseResult -> IO ParseResult
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 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
noHashFlag String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
silentFlag String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
forceFlags

      verbose :: Verbose
      verbose :: Verbose
verbose = if String
silentFlag String -> [String] -> Bool
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 (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
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 = [Bool] -> Maybe Bool
forall a. [a] -> Maybe a
listToMaybe ([Bool] -> Maybe Bool)
-> ([Bool] -> [Bool]) -> [Bool] -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Bool]
forall a. [a] -> [a]
reverse ([Bool] -> Maybe Bool) -> [Bool] -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Bool) -> [String] -> [Bool]
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 Bool -> Maybe () -> Maybe Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
hashFlag) Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False Bool -> Maybe () -> Maybe Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
noHashFlag)

      ys :: [String]
ys = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
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
"-"] -> (Maybe String, Bool) -> Either ParseResult (Maybe String, Bool)
forall a b. b -> Either a b
Right (Maybe String
forall a. Maybe a
Nothing, Bool
True)
        [String
"-", String
"-"] -> ParseResult -> Either ParseResult (Maybe String, Bool)
forall a b. a -> Either a b
Left ParseResult
ParseError
        [String
path] -> (Maybe String, Bool) -> Either ParseResult (Maybe String, Bool)
forall a b. b -> Either a b
Right (String -> Maybe String
forall a. a -> Maybe a
Just String
path, Bool
False)
        [String
path, String
"-"] -> (Maybe String, Bool) -> Either ParseResult (Maybe String, Bool)
forall a b. b -> Either a b
Right (String -> Maybe String
forall a. a -> Maybe a
Just String
path, Bool
True)
        [] -> (Maybe String, Bool) -> Either ParseResult (Maybe String, Bool)
forall a b. b -> Either a b
Right (Maybe String
forall a. Maybe a
Nothing, Bool
False)
        [String]
_ -> ParseResult -> Either ParseResult (Maybe String, Bool)
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 -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
defaultTarget
  Just String
"" -> String -> IO 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
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
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