{-# 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