{-# LANGUAGE LambdaCase #-} module Hpack.Util ( GhcOption , GhcProfOption , GhcjsOption , CppOption , CcOption , CxxOption , LdOption , parseMain , tryReadFile , expandGlobs , sort , lexicographically , Hash , sha256 , nub , nubOn ) where import Control.Exception import Control.Monad import Data.Char import Data.Bifunctor import Data.List hiding (nub, sort) import Data.Ord import qualified Data.Set as Set import System.IO.Error import System.Directory import System.FilePath import qualified System.FilePath.Posix as Posix import System.FilePath.Glob import Crypto.Hash import Hpack.Haskell import Hpack.Utf8 as Utf8 sort :: [String] -> [String] sort :: [String] -> [String] sort = (String -> String -> Ordering) -> [String] -> [String] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy ((String -> (String, String)) -> String -> String -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing String -> (String, String) lexicographically) lexicographically :: String -> (String, String) lexicographically :: String -> (String, String) lexicographically String x = ((Char -> Char) -> String -> String forall a b. (a -> b) -> [a] -> [b] map Char -> Char toLower String x, String x) type GhcOption = String type GhcProfOption = String type GhcjsOption = String type CppOption = String type CcOption = String type CxxOption = String type LdOption = String parseMain :: String -> (FilePath, [GhcOption]) parseMain :: String -> (String, [String]) parseMain String main = case [String] -> [String] forall a. [a] -> [a] reverse [String] name of String x : [String] _ | [String] -> Bool isQualifiedIdentifier [String] name Bool -> Bool -> Bool && String x String -> [String] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `notElem` [String "hs", String "lhs"] -> (String -> [String] -> String forall a. [a] -> [[a]] -> [a] intercalate String "/" ([String] -> [String] forall a. [a] -> [a] init [String] name) String -> String -> String forall a. [a] -> [a] -> [a] ++ String ".hs", [String "-main-is " String -> String -> String forall a. [a] -> [a] -> [a] ++ String main]) [String] _ | [String] -> Bool isModule [String] name -> (String -> [String] -> String forall a. [a] -> [[a]] -> [a] intercalate String "/" [String] name String -> String -> String forall a. [a] -> [a] -> [a] ++ String ".hs", [String "-main-is " String -> String -> String forall a. [a] -> [a] -> [a] ++ String main]) [String] _ -> (String main, []) where name :: [String] name = Char -> String -> [String] splitOn Char '.' String main splitOn :: Char -> String -> [String] splitOn :: Char -> String -> [String] splitOn Char c = String -> [String] go where go :: String -> [String] go String xs = case (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char c) String xs of (String ys, String "") -> [String ys] (String ys, Char _:String zs) -> String ys String -> [String] -> [String] forall a. a -> [a] -> [a] : String -> [String] go String zs tryReadFile :: FilePath -> IO (Maybe String) tryReadFile :: String -> IO (Maybe String) tryReadFile String file = do Either () String r <- (IOError -> Maybe ()) -> IO String -> IO (Either () String) forall e b a. Exception e => (e -> Maybe b) -> IO a -> IO (Either b a) tryJust (Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe () forall b c a. (b -> c) -> (a -> b) -> a -> c . IOError -> Bool isDoesNotExistError) (String -> IO String Utf8.readFile String file) Maybe String -> IO (Maybe String) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe String -> IO (Maybe String)) -> Maybe String -> IO (Maybe String) forall a b. (a -> b) -> a -> b $ (() -> Maybe String) -> (String -> Maybe String) -> Either () String -> Maybe String forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (Maybe String -> () -> Maybe String forall a b. a -> b -> a const Maybe String forall a. Maybe a Nothing) String -> Maybe String forall a. a -> Maybe a Just Either () String r toPosixFilePath :: FilePath -> FilePath toPosixFilePath :: String -> String toPosixFilePath = [String] -> String Posix.joinPath ([String] -> String) -> (String -> [String]) -> String -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> [String] splitDirectories data GlobResult = GlobResult { GlobResult -> String _globResultPattern :: String , GlobResult -> Pattern _globResultCompiledPattern :: Pattern , GlobResult -> [String] _globResultFiles :: [FilePath] } expandGlobs :: String -> FilePath -> [String] -> IO ([String], [FilePath]) expandGlobs :: String -> String -> [String] -> IO ([String], [String]) expandGlobs String name String dir [String] patterns = do [[String]] files <- [Pattern] -> String -> IO [[String]] globDir [Pattern] compiledPatterns String dir IO [[String]] -> ([[String]] -> IO [[String]]) -> IO [[String]] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= ([String] -> IO [String]) -> [[String]] -> IO [[String]] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM [String] -> IO [String] removeDirectories let results :: [GlobResult] results :: [GlobResult] results = (((String, Pattern), [String]) -> GlobResult) -> [((String, Pattern), [String])] -> [GlobResult] forall a b. (a -> b) -> [a] -> [b] map (((String, Pattern) -> [String] -> GlobResult) -> ((String, Pattern), [String]) -> GlobResult forall a b c. (a -> b -> c) -> (a, b) -> c uncurry (((String, Pattern) -> [String] -> GlobResult) -> ((String, Pattern), [String]) -> GlobResult) -> ((String, Pattern) -> [String] -> GlobResult) -> ((String, Pattern), [String]) -> GlobResult forall a b. (a -> b) -> a -> b $ (String -> Pattern -> [String] -> GlobResult) -> (String, Pattern) -> [String] -> GlobResult forall a b c. (a -> b -> c) -> (a, b) -> c uncurry String -> Pattern -> [String] -> GlobResult GlobResult) ([((String, Pattern), [String])] -> [GlobResult]) -> [((String, Pattern), [String])] -> [GlobResult] forall a b. (a -> b) -> a -> b $ [(String, Pattern)] -> [[String]] -> [((String, Pattern), [String])] forall a b. [a] -> [b] -> [(a, b)] zip ([String] -> [Pattern] -> [(String, Pattern)] forall a b. [a] -> [b] -> [(a, b)] zip [String] patterns [Pattern] compiledPatterns) (([String] -> [String]) -> [[String]] -> [[String]] forall a b. (a -> b) -> [a] -> [b] map [String] -> [String] sort [[String]] files) ([String], [String]) -> IO ([String], [String]) forall (m :: * -> *) a. Monad m => a -> m a return ([GlobResult] -> ([String], [String]) combineResults [GlobResult] results) where combineResults :: [GlobResult] -> ([String], [FilePath]) combineResults :: [GlobResult] -> ([String], [String]) combineResults = ([[String]] -> [String]) -> ([[String]] -> [String]) -> ([[String]], [[String]]) -> ([String], [String]) forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap [[String]] -> [String] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([String] -> [String] forall a. Ord a => [a] -> [a] nub ([String] -> [String]) -> ([[String]] -> [String]) -> [[String]] -> [String] forall b c a. (b -> c) -> (a -> b) -> a -> c . [[String]] -> [String] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat) (([[String]], [[String]]) -> ([String], [String])) -> ([GlobResult] -> ([[String]], [[String]])) -> [GlobResult] -> ([String], [String]) forall b c a. (b -> c) -> (a -> b) -> a -> c . [([String], [String])] -> ([[String]], [[String]]) forall a b. [(a, b)] -> ([a], [b]) unzip ([([String], [String])] -> ([[String]], [[String]])) -> ([GlobResult] -> [([String], [String])]) -> [GlobResult] -> ([[String]], [[String]]) forall b c a. (b -> c) -> (a -> b) -> a -> c . (GlobResult -> ([String], [String])) -> [GlobResult] -> [([String], [String])] forall a b. (a -> b) -> [a] -> [b] map GlobResult -> ([String], [String]) fromResult fromResult :: GlobResult -> ([String], [FilePath]) fromResult :: GlobResult -> ([String], [String]) fromResult (GlobResult String pattern Pattern compiledPattern [String] files) = case [String] files of [] -> ([String] warning, [String] literalFile) [String] xs -> ([], (String -> String) -> [String] -> [String] forall a b. (a -> b) -> [a] -> [b] map String -> String normalize [String] xs) where warning :: [String] warning = [String -> Pattern -> String warn String pattern Pattern compiledPattern] literalFile :: [String] literalFile | Pattern -> Bool isLiteral Pattern compiledPattern = [String pattern] | Bool otherwise = [] normalize :: FilePath -> FilePath normalize :: String -> String normalize = String -> String toPosixFilePath (String -> String) -> (String -> String) -> String -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String -> String makeRelative String dir warn :: String -> Pattern -> String warn :: String -> Pattern -> String warn String pattern Pattern compiledPattern | Pattern -> Bool isLiteral Pattern compiledPattern = String "Specified file " String -> String -> String forall a. [a] -> [a] -> [a] ++ String -> String forall a. Show a => a -> String show String pattern String -> String -> String forall a. [a] -> [a] -> [a] ++ String " for " String -> String -> String forall a. [a] -> [a] -> [a] ++ String name String -> String -> String forall a. [a] -> [a] -> [a] ++ String " does not exist" | Bool otherwise = String "Specified pattern " String -> String -> String forall a. [a] -> [a] -> [a] ++ String -> String forall a. Show a => a -> String show String pattern String -> String -> String forall a. [a] -> [a] -> [a] ++ String " for " String -> String -> String forall a. [a] -> [a] -> [a] ++ String name String -> String -> String forall a. [a] -> [a] -> [a] ++ String " does not match any files" compiledPatterns :: [Pattern] compiledPatterns :: [Pattern] compiledPatterns = (String -> Pattern) -> [String] -> [Pattern] forall a b. (a -> b) -> [a] -> [b] map (CompOptions -> String -> Pattern compileWith CompOptions options) [String] patterns removeDirectories :: [FilePath] -> IO [FilePath] removeDirectories :: [String] -> IO [String] removeDirectories = (String -> IO Bool) -> [String] -> IO [String] forall (m :: * -> *) a. Applicative m => (a -> m Bool) -> [a] -> m [a] filterM String -> IO Bool doesFileExist options :: CompOptions options :: CompOptions options = CompOptions :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> CompOptions CompOptions { characterClasses :: Bool characterClasses = Bool False , characterRanges :: Bool characterRanges = Bool False , numberRanges :: Bool numberRanges = Bool False , wildcards :: Bool wildcards = Bool True , recursiveWildcards :: Bool recursiveWildcards = Bool True , pathSepInRanges :: Bool pathSepInRanges = Bool False , errorRecovery :: Bool errorRecovery = Bool True } type Hash = String sha256 :: String -> Hash sha256 :: String -> String sha256 String c = Digest SHA256 -> String forall a. Show a => a -> String show (ByteString -> Digest SHA256 forall ba a. (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a hash (String -> ByteString Utf8.encodeUtf8 String c) :: Digest SHA256) nub :: Ord a => [a] -> [a] nub :: [a] -> [a] nub = (a -> a) -> [a] -> [a] forall b a. Ord b => (a -> b) -> [a] -> [a] nubOn a -> a forall a. a -> a id nubOn :: Ord b => (a -> b) -> [a] -> [a] nubOn :: (a -> b) -> [a] -> [a] nubOn a -> b f = Set b -> [a] -> [a] go Set b forall a. Monoid a => a mempty where go :: Set b -> [a] -> [a] go Set b seen = \ case [] -> [] a a : [a] as | b b b -> Set b -> Bool forall a. Ord a => a -> Set a -> Bool `Set.member` Set b seen -> Set b -> [a] -> [a] go Set b seen [a] as | Bool otherwise -> a a a -> [a] -> [a] forall a. a -> [a] -> [a] : Set b -> [a] -> [a] go (b -> Set b -> Set b forall a. Ord a => a -> Set a -> Set a Set.insert b b Set b seen) [a] as where b :: b b = a -> b f a a