    {-# LANGUAGE LambdaCase #-}
    module Hpack.Util (
      GhcOption
    , GhcProfOption
    , GhcjsOption
    , CppOption
    , CcOption
    , CxxOption
    , LdOption
    , parseMain

    , tryReadFile
    , expandGlobs
    , sort
    , lexicographically
    , Hash
    , sha256

    , nub
    , nubOn
    ) where

    import           Imports

    import           Control.Exception
    import           Data.Char
    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. HasCallStack => [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 a. a -> IO a
    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 a b. IO a -> (a -> IO b) -> IO b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> IO a
    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 a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    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 {
            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 :: forall a. Ord a => [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 :: forall b a. Ord b => (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