    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ForeignFunctionInterface #-}
    -- File created: 2008-10-10 13:40:35

    module System.FilePath.Glob.Utils
       ( isLeft, fromLeft
       , increasingSeq
       , addToRange, inRange, overlap
       , dropLeadingZeroes
       , pathParts
       , nubOrd
       , partitionDL, tailDL
       , getRecursiveContents
       , catchIO
       ) where

    import Control.Monad    (foldM)
    import qualified Control.Exception as E
    import Data.List        ((\\))
    import qualified Data.DList as DL
    import Data.DList       (DList)
    import qualified Data.Set as Set
    import System.Directory (getDirectoryContents)
    import System.FilePath  ((</>), isPathSeparator, dropDrive)
    import System.IO.Unsafe (unsafeInterleaveIO)

    #if mingw32_HOST_OS
    import Data.Bits          ((.&.))
    import System.Win32.Types (withTString)
    import System.Win32.File  (FileAttributeOrFlag, fILE_ATTRIBUTE_DIRECTORY)
    import System.Win32.String (LPCTSTR)
    #else
    import Foreign.C.String      (withCString)
    import Foreign.Marshal.Alloc (allocaBytes)
    import System.FilePath
       (isDrive, dropTrailingPathSeparator, addTrailingPathSeparator)
    import System.Posix.Internals (sizeof_stat, lstat, s_isdir, st_mode)
    #endif

    inRange :: Ord a => (a,a) -> a -> Bool
    inRange :: forall a. Ord a => (a, a) -> a -> Bool
    inRange (a
    a,a
    b) a
    c = a
    c a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    a Bool -> Bool -> Bool
    && a
    c a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    b

    -- returns Just (a range which covers both given ranges) or Nothing if they are

    -- disjoint.

    --

    -- Assumes that the ranges are in the correct order, i.e. (fst x < snd x).

    overlap :: Ord a => (a,a) -> (a,a) -> Maybe (a,a)
    overlap :: forall a. Ord a => (a, a) -> (a, a) -> Maybe (a, a)
    overlap (a
    a,a
    b) (a
    c,a
    d) =
       if a
    b a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    c
          then if a
    b a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    d
                  then if a
    a a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    c
                          then (a, a) -> Maybe (a, a)
    forall a. a -> Maybe a
    Just (a
    a,a
    b)
                          else (a, a) -> Maybe (a, a)
    forall a. a -> Maybe a
    Just (a
    c,a
    b)
                  else if a
    a a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    c
                          then (a, a) -> Maybe (a, a)
    forall a. a -> Maybe a
    Just (a
    a,a
    d)
                          else (a, a) -> Maybe (a, a)
    forall a. a -> Maybe a
    Just (a
    c,a
    d)
          else Maybe (a, a)
    forall a. Maybe a
    Nothing

    addToRange :: (Ord a, Enum a) => (a,a) -> a -> Maybe (a,a)
    addToRange :: forall a. (Ord a, Enum a) => (a, a) -> a -> Maybe (a, a)
    addToRange (a
    a,a
    b) a
    c
       | (a, a) -> a -> Bool
    forall a. Ord a => (a, a) -> a -> Bool
    inRange (a
    a,a
    b) a
    c = (a, a) -> Maybe (a, a)
    forall a. a -> Maybe a
    Just (a
    a,a
    b)
       | a
    c a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> a
    forall a. Enum a => a -> a
    pred a
    a     = (a, a) -> Maybe (a, a)
    forall a. a -> Maybe a
    Just (a
    c,a
    b)
       | a
    c a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> a
    forall a. Enum a => a -> a
    succ a
    b     = (a, a) -> Maybe (a, a)
    forall a. a -> Maybe a
    Just (a
    a,a
    c)
       | Bool
    otherwise       = Maybe (a, a)
    forall a. Maybe a
    Nothing

    -- fst of result is in reverse order so that:

    --

    -- If x = fst (increasingSeq (a:xs)), then

    -- x == reverse [a .. head x]

    increasingSeq :: (Eq a, Enum a) => [a] -> ([a],[a])
    increasingSeq :: forall a. (Eq a, Enum a) => [a] -> ([a], [a])
    increasingSeq []     = ([],[])
    increasingSeq (a
    x:[a]
    xs) = [a] -> [a] -> ([a], [a])
    forall {a}. (Eq a, Enum a) => [a] -> [a] -> ([a], [a])
    go [a
    x] [a]
    xs
     where
       go :: [a] -> [a] -> ([a], [a])
    go [a]
    is       []     = ([a]
    is,[])
       go is :: [a]
    is@(a
    i:[a]
    _) (a
    y:[a]
    ys) =
          if a
    y a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> a
    forall a. Enum a => a -> a
    succ a
    i
             then [a] -> [a] -> ([a], [a])
    go (a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    is) [a]
    ys
             else ([a]
    is, a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)
       go [a]
    _ [a]
    _ = FilePath -> ([a], [a])
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "Glob.increasingSeq :: internal error"

    isLeft :: Either a b -> Bool
    isLeft :: forall a b. Either a b -> Bool
    isLeft (Left a
    _) = Bool
    True
    isLeft Either a b
    _        = Bool
    False

    fromLeft :: Either a b -> a
    fromLeft :: forall a b. Either a b -> a
    fromLeft (Left a
    x) = a
    x
    fromLeft Either a b
    _        = FilePath -> a
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "fromLeft :: Right"

    dropLeadingZeroes :: String -> String
    dropLeadingZeroes :: FilePath -> FilePath
    dropLeadingZeroes FilePath
    s =
       let x :: FilePath
    x = (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '0') FilePath
    s
        in if FilePath -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null FilePath
    x then FilePath
    "0" else FilePath
    x

    -- foo/bar/baz -> [foo/bar/baz,bar/baz,baz]

    pathParts :: FilePath -> [FilePath]
    pathParts :: FilePath -> [FilePath]
    pathParts FilePath
    p = FilePath
    p FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : let d :: FilePath
    d = FilePath -> FilePath
    dropDrive FilePath
    p
                       in if FilePath -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null FilePath
    d Bool -> Bool -> Bool
    || FilePath
    d FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    p
                             then     FilePath -> [FilePath]
    f FilePath
    d
                             else FilePath
    d FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : FilePath -> [FilePath]
    f FilePath
    d
     where
       f :: FilePath -> [FilePath]
    f []  = []
       f (Char
    x:xs :: FilePath
    xs@(Char
    y:FilePath
    _)) | Char -> Bool
    isPathSeparator Char
    x Bool -> Bool -> Bool
    && Char -> Bool
    isPathSeparator Char
    y = FilePath -> [FilePath]
    f FilePath
    xs
       f (Char
    x:FilePath
    xs) =
          if Char -> Bool
    isPathSeparator Char
    x
             then FilePath
    xs FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : FilePath -> [FilePath]
    f FilePath
    xs
             else      FilePath -> [FilePath]
    f FilePath
    xs

    -- Significantly speedier than System.Directory.doesDirectoryExist.

    doesDirectoryExist :: FilePath -> IO Bool
    #if mingw32_HOST_OS
    -- This one allocates more memory since it has to do a UTF-16 conversion, but

    -- that can't really be helped: the below version is locale-dependent.

    doesDirectoryExist = flip withTString $ \s -> do
       a <- c_GetFileAttributes s
       return (a /= 0xffffffff && a.&.fILE_ATTRIBUTE_DIRECTORY /= 0)
    #else
    doesDirectoryExist :: FilePath -> IO Bool
    doesDirectoryExist FilePath
    s =
       Int -> (Ptr CStat -> IO Bool) -> IO Bool
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes Int
    sizeof_stat ((Ptr CStat -> IO Bool) -> IO Bool)
    -> (Ptr CStat -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Ptr CStat
    p ->
          FilePath -> (CString -> IO Bool) -> IO Bool
    forall a. FilePath -> (CString -> IO a) -> IO a
    withCString
             (if FilePath -> Bool
    isDrive FilePath
    s
                 then FilePath -> FilePath
    addTrailingPathSeparator FilePath
    s
                 else FilePath -> FilePath
    dropTrailingPathSeparator FilePath
    s)
             ((CString -> IO Bool) -> IO Bool)
    -> (CString -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \CString
    c -> do
                CInt
    st <- CString -> Ptr CStat -> IO CInt
    lstat CString
    c Ptr CStat
    p
                if CInt
    st CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    == CInt
    0
                   then (CMode -> Bool) -> IO CMode -> IO Bool
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CMode -> Bool
    s_isdir (Ptr CStat -> IO CMode
    st_mode Ptr CStat
    p)
                   else Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    #endif

    #if mingw32_HOST_OS
    #if defined(i386_HOST_ARCH)
    foreign import stdcall unsafe "windows.h GetFileAttributesW" c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag
    #elif defined(x86_64_HOST_ARCH)
    foreign import ccall unsafe "windows.h GetFileAttributesW" c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag
    #else
    #error Unknown mingw32 arch
    #endif
    #endif

    getRecursiveContents :: FilePath -> IO (DList FilePath)
    getRecursiveContents :: FilePath -> IO (DList FilePath)
    getRecursiveContents FilePath
    dir =
       (IO (DList FilePath)
     -> (IOException -> IO (DList FilePath)) -> IO (DList FilePath))
    -> (IOException -> IO (DList FilePath))
    -> IO (DList FilePath)
    -> IO (DList FilePath)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO (DList FilePath)
    -> (IOException -> IO (DList FilePath)) -> IO (DList FilePath)
    forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO (\IOException
    _ -> DList FilePath -> IO (DList FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList FilePath -> IO (DList FilePath))
    -> DList FilePath -> IO (DList FilePath)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> DList FilePath
    forall a. a -> DList a
    DL.singleton FilePath
    dir) (IO (DList FilePath) -> IO (DList FilePath))
    -> IO (DList FilePath) -> IO (DList FilePath)
    forall a b. (a -> b) -> a -> b
    $ do

          [FilePath]
    raw <- FilePath -> IO [FilePath]
    getDirectoryContents FilePath
    dir

          let entries :: [FilePath]
    entries = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath
    dir FilePath -> FilePath -> FilePath
    </>) ([FilePath]
    raw [FilePath] -> [FilePath] -> [FilePath]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [FilePath
    ".",FilePath
    ".."])
          ([FilePath]
    dirs,[FilePath]
    files) <- (FilePath -> IO Bool) -> [FilePath] -> IO ([FilePath], [FilePath])
    forall (m :: * -> *) a.
    Monad m =>
    (a -> m Bool) -> [a] -> m ([a], [a])
    partitionM FilePath -> IO Bool
    doesDirectoryExist [FilePath]
    entries

          [DList FilePath]
    subs <- IO [DList FilePath] -> IO [DList FilePath]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [DList FilePath] -> IO [DList FilePath])
    -> ([FilePath] -> IO [DList FilePath])
    -> [FilePath]
    -> IO [DList FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath -> IO (DList FilePath))
    -> [FilePath] -> IO [DList FilePath]
    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 FilePath -> IO (DList FilePath)
    getRecursiveContents ([FilePath] -> IO [DList FilePath])
    -> [FilePath] -> IO [DList FilePath]
    forall a b. (a -> b) -> a -> b
    $ [FilePath]
    dirs

          DList FilePath -> IO (DList FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(DList FilePath -> IO (DList FilePath))
    -> DList FilePath -> IO (DList FilePath)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> DList FilePath -> DList FilePath
    forall a. a -> DList a -> DList a
    DL.cons FilePath
    dir ([FilePath] -> DList FilePath
    forall a. [a] -> DList a
    DL.fromList [FilePath]
    files DList FilePath -> DList FilePath -> DList FilePath
    forall a. DList a -> DList a -> DList a
    `DL.append` [DList FilePath] -> DList FilePath
    forall a. [DList a] -> DList a
    DL.concat [DList FilePath]
    subs)

    partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a])
    partitionM :: forall (m :: * -> *) a.
    Monad m =>
    (a -> m Bool) -> [a] -> m ([a], [a])
    partitionM a -> m Bool
    p_ = (([a], [a]) -> a -> m ([a], [a]))
    -> ([a], [a]) -> [a] -> m ([a], [a])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ((a -> m Bool) -> ([a], [a]) -> a -> m ([a], [a])
    forall {m :: * -> *} {a}.
    Monad m =>
    (a -> m Bool) -> ([a], [a]) -> a -> m ([a], [a])
    f a -> m Bool
    p_) ([],[])
     where
       f :: (a -> m Bool) -> ([a], [a]) -> a -> m ([a], [a])
    f a -> m Bool
    p ([a]
    ts,[a]
    fs) a
    x = a -> m Bool
    p a
    x m Bool -> (Bool -> m ([a], [a])) -> m ([a], [a])
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    b ->
          if Bool
    b
             then ([a], [a]) -> m ([a], [a])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ts, [a]
    fs)
             else ([a], [a]) -> m ([a], [a])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([a]
    ts, a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    fs)

    partitionDL :: (a -> Bool) -> DList a -> (DList a, DList a)
    partitionDL :: forall a. (a -> Bool) -> DList a -> (DList a, DList a)
    partitionDL a -> Bool
    p_ = (a -> (DList a, DList a) -> (DList a, DList a))
    -> (DList a, DList a) -> DList a -> (DList a, DList a)
    forall a b. (a -> b -> b) -> b -> DList a -> b
    DL.foldr ((a -> Bool) -> a -> (DList a, DList a) -> (DList a, DList a)
    forall {a}.
    (a -> Bool) -> a -> (DList a, DList a) -> (DList a, DList a)
    f a -> Bool
    p_) (DList a
    forall a. DList a
    DL.empty,DList a
    forall a. DList a
    DL.empty)
     where
       f :: (a -> Bool) -> a -> (DList a, DList a) -> (DList a, DList a)
    f a -> Bool
    p a
    x (DList a
    ts,DList a
    fs) =
          if a -> Bool
    p a
    x
             then (a -> DList a -> DList a
    forall a. a -> DList a -> DList a
    DL.cons a
    x DList a
    ts, DList a
    fs)
             else (DList a
    ts, a -> DList a -> DList a
    forall a. a -> DList a -> DList a
    DL.cons a
    x DList a
    fs)

    tailDL :: DList a -> DList a
    #if MIN_VERSION_dlist(1,0,0)
    tailDL :: forall a. DList a -> DList a
    tailDL = [a] -> DList a
    forall a. [a] -> DList a
    DL.fromList ([a] -> DList a) -> (DList a -> [a]) -> DList a -> DList a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DList a -> [a]
    forall a. DList a -> [a]
    DL.tail
    #else
    tailDL = DL.tail
    #endif

    nubOrd :: Ord a => [a] -> [a]
    nubOrd :: forall a. Ord a => [a] -> [a]
    nubOrd = Set a -> [a] -> [a]
    forall {a}. Ord a => Set a -> [a] -> [a]
    go Set a
    forall a. Set a
    Set.empty
     where
       go :: Set a -> [a] -> [a]
    go Set a
    _ [] = []
       go Set a
    set (a
    x:[a]
    xs) =
          if a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member a
    x Set a
    set
             then Set a -> [a] -> [a]
    go Set a
    set [a]
    xs
             else a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : Set a -> [a] -> [a]
    go (a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    Set.insert a
    x Set a
    set) [a]
    xs

    catchIO :: IO a -> (E.IOException -> IO a) -> IO a
    catchIO :: forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO = IO a -> (IOException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch