{-# LANGUAGE OverloadedStrings #-}
module PathFilter where
import Data.Text.Short (ShortText)
import qualified Data.Text.Short as ShortText
import Path (Dir, File, Path, Rel)
import qualified Path
data PathAccept
=
Accept
|
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)
toBool :: PathAccept -> Bool
toBool :: PathAccept -> Bool
toBool PathAccept
Accept = Bool
True
toBool PathAccept
Reject = Bool
False
fromBool :: Bool -> PathAccept
fromBool :: Bool -> PathAccept
fromBool Bool
True = PathAccept
Accept
fromBool Bool
False = PathAccept
Reject
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
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
".")
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")
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)
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
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