{-# 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 = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (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 = (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 forall a. [a] -> [a]
reverse [String]
name of
  String
x : [String]
_ | [String] -> Bool
isQualifiedIdentifier [String]
name Bool -> Bool -> Bool
&& String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"hs", String
"lhs"] -> (forall a. [a] -> [[a]] -> [a]
intercalate String
"/" (forall a. [a] -> [a]
init [String]
name) forall a. [a] -> [a] -> [a]
++ String
".hs", [String
"-main-is " forall a. [a] -> [a] -> [a]
++ String
main])
  [String]
_ | [String] -> Bool
isModule [String]
name -> (forall a. [a] -> [[a]] -> [a]
intercalate String
"/" [String]
name forall a. [a] -> [a] -> [a]
++ String
".hs", [String
"-main-is " 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
c) String
xs of
      (String
ys, String
"") -> [String
ys]
      (String
ys, Char
_:String
zs) -> String
ys 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 <- forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (String -> IO String
Utf8.readFile String
file)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just Either () String
r

toPosixFilePath :: FilePath -> FilePath
toPosixFilePath :: String -> String
toPosixFilePath = [String] -> String
Posix.joinPath 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Pattern -> [String] -> GlobResult
GlobResult) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
patterns [Pattern]
compiledPatterns) (forall a b. (a -> b) -> [a] -> [b]
map [String] -> [String]
sort [[String]]
files)
  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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Ord a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> ([], 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 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
pattern forall a. [a] -> [a] -> [a]
++ String
" for " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" does not exist"
      | Bool
otherwise = String
"Specified pattern " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
pattern forall a. [a] -> [a] -> [a]
++ String
" for " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" does not match any files"

    compiledPatterns :: [Pattern]
    compiledPatterns :: [Pattern]
compiledPatterns = 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 = 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 = forall a. Show a => a -> String
show (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 = forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn 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 forall a. Monoid a => a
mempty
  where
    go :: Set b -> [a] -> [a]
go Set b
seen = \ case
        [] -> []
        a
a : [a]
as
          | b
b 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 forall a. a -> [a] -> [a]
: Set b -> [a] -> [a]
go (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