{-# LANGUAGE OverloadedStrings #-}

-- |
-- Description : Filters for file paths.
module PathFilter where

import Data.Text.Short (ShortText)
import qualified Data.Text.Short as ShortText
import Path (Dir, File, Path, Rel)
import qualified Path

-- | Does a filter accept a path?
data PathAccept
  = -- | Filter accepts the path.
    Accept
  | -- | Filter rejects the path.
    Reject
  deriving (Int -> PathAccept -> ShowS
[PathAccept] -> ShowS
PathAccept -> String
(Int -> PathAccept -> ShowS)
-> (PathAccept -> String)
-> ([PathAccept] -> ShowS)
-> Show PathAccept
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathAccept] -> ShowS
$cshowList :: [PathAccept] -> ShowS
show :: PathAccept -> String
$cshow :: PathAccept -> String
showsPrec :: Int -> PathAccept -> ShowS
$cshowsPrec :: Int -> PathAccept -> ShowS
Show)

-- | Convert a 'PathAccept' type to a 'Bool' suitable for filtering.
toBool :: PathAccept -> Bool
toBool :: PathAccept -> Bool
toBool PathAccept
Accept = Bool
True
toBool PathAccept
Reject = Bool
False

-- | Convert a 'Bool' to a 'PathAccept'.
fromBool :: Bool -> PathAccept
fromBool :: Bool -> PathAccept
fromBool Bool
True = PathAccept
Accept
fromBool Bool
False = PathAccept
Reject

-- | Path filter: examine a relative file and decide if we accept it.
newtype PathFilter = PathFilter
  { PathFilter -> Path Rel File -> PathAccept
unPathFilter :: Path Rel File -> PathAccept
  }

instance Semigroup PathFilter where
  PathFilter
f1 <> :: PathFilter -> PathFilter -> PathFilter
<> PathFilter
f2 = (Path Rel File -> PathAccept) -> PathFilter
PathFilter ((Path Rel File -> PathAccept) -> PathFilter)
-> (Path Rel File -> PathAccept) -> PathFilter
forall a b. (a -> b) -> a -> b
$ \Path Rel File
path ->
    case PathFilter -> Path Rel File -> PathAccept
unPathFilter PathFilter
f1 Path Rel File
path of
      PathAccept
Reject -> PathAccept
Reject
      PathAccept
Accept -> PathFilter -> Path Rel File -> PathAccept
unPathFilter PathFilter
f2 Path Rel File
path

instance Monoid PathFilter where
  mempty :: PathFilter
mempty = (Path Rel File -> PathAccept) -> PathFilter
PathFilter ((Path Rel File -> PathAccept) -> PathFilter)
-> (Path Rel File -> PathAccept) -> PathFilter
forall a b. (a -> b) -> a -> b
$ PathAccept -> Path Rel File -> PathAccept
forall a b. a -> b -> a
const PathAccept
Accept

-- | PathFilter that excludes hidden files or directories, starting with a
--   period.
--
-- For example:
--
-- >>> :set -XQuasiQuotes
-- >>> import qualified Path
-- >>> unPathFilter pfNoHidden [Path.relfile|src/.hidden/something.txt|]
-- Reject
-- >>> unPathFilter pfNoHidden [Path.relfile|src/nothidden/something.txt|]
-- Accept
pfNoHidden :: PathFilter
pfNoHidden :: PathFilter
pfNoHidden = (ShortText -> PathAccept) -> PathFilter
componentFilter (Bool -> PathAccept
fromBool (Bool -> PathAccept)
-> (ShortText -> Bool) -> ShortText -> PathAccept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ShortText -> Bool
ShortText.isPrefixOf ShortText
".")

-- | PathFilter that excludes any path components that are named
--   @dist-newstyle@.
pfNoDistNewstyle :: PathFilter
pfNoDistNewstyle :: PathFilter
pfNoDistNewstyle = (ShortText -> PathAccept) -> PathFilter
componentFilter (Bool -> PathAccept
fromBool (Bool -> PathAccept)
-> (ShortText -> Bool) -> ShortText -> PathAccept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ShortText -> Bool
forall a. Eq a => a -> a -> Bool
(==) ShortText
"dist-newstyle")

-- | PathFilter that keeps only files with a given extension.
--
-- The extension to be tested should start with a period.
--
-- For example:
--
-- >>> :set -XQuasiQuotes -XOverloadedStrings
-- >>> import qualified Path
-- >>> pfHs = pfExtension ".hs"
-- >>> unPathFilter pfHs [Path.relfile|src/ModuleA/ModuleB.hs|]
-- Accept
-- >>> unPathFilter pfHs [Path.relfile|src/ModuleA/something.txt|]
-- Reject
pfExtension :: ShortText -> PathFilter
pfExtension :: ShortText -> PathFilter
pfExtension ShortText
extension = (Path Rel File -> PathAccept) -> PathFilter
PathFilter ((Path Rel File -> PathAccept) -> PathFilter)
-> (Path Rel File -> PathAccept) -> PathFilter
forall a b. (a -> b) -> a -> b
$ \Path Rel File
path -> Bool -> PathAccept
fromBool (Path Rel File -> Bool
extensionMatches Path Rel File
path)
  where
    extensionMatches :: Path Rel File -> Bool
    extensionMatches :: Path Rel File -> Bool
extensionMatches Path Rel File
path = ShortText
extension ShortText -> ShortText -> Bool
forall a. Eq a => a -> a -> Bool
== Path Rel File -> ShortText
ext Path Rel File
path

    ext :: Path Rel File -> ShortText
    ext :: Path Rel File -> ShortText
ext Path Rel File
path = ShortText -> (String -> ShortText) -> Maybe String -> ShortText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShortText
"" String -> ShortText
ShortText.pack (Path Rel File -> Maybe String
forall (m :: * -> *) b. MonadThrow m => Path b File -> m String
Path.fileExtension Path Rel File
path)

-- | Create a filter from a function that examines each component of a path.
componentFilter :: (ShortText -> PathAccept) -> PathFilter
componentFilter :: (ShortText -> PathAccept) -> PathFilter
componentFilter ShortText -> PathAccept
f = (Path Rel File -> PathAccept) -> PathFilter
PathFilter ((Path Rel File -> PathAccept) -> PathFilter)
-> (Path Rel File -> PathAccept) -> PathFilter
forall a b. (a -> b) -> a -> b
$ \Path Rel File
path ->
  Bool -> PathAccept
fromBool (Bool -> PathAccept)
-> (Path Rel File -> Bool) -> Path Rel File -> PathAccept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Path Rel File -> Bool) -> Path Rel File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortText -> Bool) -> [ShortText] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PathAccept -> Bool
toBool (PathAccept -> Bool)
-> (ShortText -> PathAccept) -> ShortText -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> PathAccept
f) ([ShortText] -> Bool)
-> (Path Rel File -> [ShortText]) -> Path Rel File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> [ShortText]
pathComponents (Path Rel File -> PathAccept) -> Path Rel File -> PathAccept
forall a b. (a -> b) -> a -> b
$ Path Rel File
path

-- | Return the components of a path as a list.
--
-- For example:
--
-- >>> :set -XQuasiQuotes
-- >>> import qualified Path
-- >>> pathComponents [Path.relfile|dir/package/file.txt|]
-- ["dir","package","file.txt"]
-- >>> pathComponents [Path.relfile|file.txt|]
-- ["file.txt"]
pathComponents :: Path Rel File -> [ShortText]
pathComponents :: Path Rel File -> [ShortText]
pathComponents Path Rel File
filePath = [ShortText]
components
  where
    components :: [ShortText]
    components :: [ShortText]
components = [ShortText] -> [ShortText]
forall a. [a] -> [a]
reverse (ShortText
fileName ShortText -> [ShortText] -> [ShortText]
forall a. a -> [a] -> [a]
: [ShortText]
pathParts)

    fileName :: ShortText
    fileName :: ShortText
fileName = String -> ShortText
ShortText.pack (String -> ShortText)
-> (Path Rel File -> String) -> Path Rel File -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> String
Path.fromRelFile (Path Rel File -> String)
-> (Path Rel File -> Path Rel File) -> Path Rel File -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> Path Rel File
forall b. Path b File -> Path Rel File
Path.filename (Path Rel File -> ShortText) -> Path Rel File -> ShortText
forall a b. (a -> b) -> a -> b
$ Path Rel File
filePath

    pathParts :: [ShortText]
    pathParts :: [ShortText]
pathParts = Path Rel Dir -> [ShortText]
go (Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel File
filePath)

    go :: Path Rel Dir -> [ShortText]
    go :: Path Rel Dir -> [ShortText]
go Path Rel Dir
dir
      | Path Rel Dir -> Bool
isTopDir Path Rel Dir
dir = []
      | Bool
otherwise = Path Rel Dir -> ShortText
curDirComp Path Rel Dir
dir ShortText -> [ShortText] -> [ShortText]
forall a. a -> [a] -> [a]
: Path Rel Dir -> [ShortText]
go (Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel Dir
dir)
      where
        isTopDir :: Path Rel Dir -> Bool
        isTopDir :: Path Rel Dir -> Bool
isTopDir Path Rel Dir
d = Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel Dir
d Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path Rel Dir
d

        curDirComp :: Path Rel Dir -> ShortText
        curDirComp :: Path Rel Dir -> ShortText
curDirComp Path Rel Dir
d =
          String -> ShortText
ShortText.pack (String -> ShortText)
-> (Path Rel Dir -> String) -> Path Rel Dir -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
init ShowS -> (Path Rel Dir -> String) -> Path Rel Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> String
Path.fromRelDir (Path Rel Dir -> String)
-> (Path Rel Dir -> Path Rel Dir) -> Path Rel Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
Path.dirname (Path Rel Dir -> ShortText) -> Path Rel Dir -> ShortText
forall a b. (a -> b) -> a -> b
$ Path Rel Dir
d