{-# LANGUAGE DeriveGeneric #-}
module Distribution.Simple.FileMonitor.Types
(
RootedGlob (..)
, FilePathRoot (..)
, Glob
, MonitorFilePath (..)
, MonitorKindFile (..)
, MonitorKindDir (..)
, monitorFile
, monitorFileHashed
, monitorNonExistentFile
, monitorFileExistence
, monitorDirectory
, monitorNonExistentDirectory
, monitorDirectoryExistence
, monitorFileOrDirectory
, monitorFileGlob
, monitorFileGlobExistence
, monitorFileSearchPath
, monitorFileHashedSearchPath
)
where
import Distribution.Compat.Prelude
import Distribution.Simple.Glob.Internal
( Glob (..)
)
import qualified Distribution.Compat.CharParsing as P
import Distribution.Parsec
import Distribution.Pretty
import qualified Text.PrettyPrint as Disp
data RootedGlob
= RootedGlob
FilePathRoot
Glob
deriving (RootedGlob -> RootedGlob -> Bool
(RootedGlob -> RootedGlob -> Bool)
-> (RootedGlob -> RootedGlob -> Bool) -> Eq RootedGlob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RootedGlob -> RootedGlob -> Bool
== :: RootedGlob -> RootedGlob -> Bool
$c/= :: RootedGlob -> RootedGlob -> Bool
/= :: RootedGlob -> RootedGlob -> Bool
Eq, Int -> RootedGlob -> ShowS
[RootedGlob] -> ShowS
RootedGlob -> String
(Int -> RootedGlob -> ShowS)
-> (RootedGlob -> String)
-> ([RootedGlob] -> ShowS)
-> Show RootedGlob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RootedGlob -> ShowS
showsPrec :: Int -> RootedGlob -> ShowS
$cshow :: RootedGlob -> String
show :: RootedGlob -> String
$cshowList :: [RootedGlob] -> ShowS
showList :: [RootedGlob] -> ShowS
Show, (forall x. RootedGlob -> Rep RootedGlob x)
-> (forall x. Rep RootedGlob x -> RootedGlob) -> Generic RootedGlob
forall x. Rep RootedGlob x -> RootedGlob
forall x. RootedGlob -> Rep RootedGlob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RootedGlob -> Rep RootedGlob x
from :: forall x. RootedGlob -> Rep RootedGlob x
$cto :: forall x. Rep RootedGlob x -> RootedGlob
to :: forall x. Rep RootedGlob x -> RootedGlob
Generic)
instance Binary RootedGlob
instance Structured RootedGlob
data FilePathRoot
= FilePathRelative
|
FilePathRoot FilePath
| FilePathHomeDir
deriving (FilePathRoot -> FilePathRoot -> Bool
(FilePathRoot -> FilePathRoot -> Bool)
-> (FilePathRoot -> FilePathRoot -> Bool) -> Eq FilePathRoot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilePathRoot -> FilePathRoot -> Bool
== :: FilePathRoot -> FilePathRoot -> Bool
$c/= :: FilePathRoot -> FilePathRoot -> Bool
/= :: FilePathRoot -> FilePathRoot -> Bool
Eq, Int -> FilePathRoot -> ShowS
[FilePathRoot] -> ShowS
FilePathRoot -> String
(Int -> FilePathRoot -> ShowS)
-> (FilePathRoot -> String)
-> ([FilePathRoot] -> ShowS)
-> Show FilePathRoot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilePathRoot -> ShowS
showsPrec :: Int -> FilePathRoot -> ShowS
$cshow :: FilePathRoot -> String
show :: FilePathRoot -> String
$cshowList :: [FilePathRoot] -> ShowS
showList :: [FilePathRoot] -> ShowS
Show, (forall x. FilePathRoot -> Rep FilePathRoot x)
-> (forall x. Rep FilePathRoot x -> FilePathRoot)
-> Generic FilePathRoot
forall x. Rep FilePathRoot x -> FilePathRoot
forall x. FilePathRoot -> Rep FilePathRoot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FilePathRoot -> Rep FilePathRoot x
from :: forall x. FilePathRoot -> Rep FilePathRoot x
$cto :: forall x. Rep FilePathRoot x -> FilePathRoot
to :: forall x. Rep FilePathRoot x -> FilePathRoot
Generic)
instance Binary FilePathRoot
instance Structured FilePathRoot
data MonitorFilePath
= MonitorFile
{ MonitorFilePath -> MonitorKindFile
monitorKindFile :: !MonitorKindFile
, MonitorFilePath -> MonitorKindDir
monitorKindDir :: !MonitorKindDir
, MonitorFilePath -> String
monitorPath :: !FilePath
}
| MonitorFileGlob
{ monitorKindFile :: !MonitorKindFile
, monitorKindDir :: !MonitorKindDir
, MonitorFilePath -> RootedGlob
monitorPathGlob :: !RootedGlob
}
deriving (MonitorFilePath -> MonitorFilePath -> Bool
(MonitorFilePath -> MonitorFilePath -> Bool)
-> (MonitorFilePath -> MonitorFilePath -> Bool)
-> Eq MonitorFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonitorFilePath -> MonitorFilePath -> Bool
== :: MonitorFilePath -> MonitorFilePath -> Bool
$c/= :: MonitorFilePath -> MonitorFilePath -> Bool
/= :: MonitorFilePath -> MonitorFilePath -> Bool
Eq, Int -> MonitorFilePath -> ShowS
[MonitorFilePath] -> ShowS
MonitorFilePath -> String
(Int -> MonitorFilePath -> ShowS)
-> (MonitorFilePath -> String)
-> ([MonitorFilePath] -> ShowS)
-> Show MonitorFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorFilePath -> ShowS
showsPrec :: Int -> MonitorFilePath -> ShowS
$cshow :: MonitorFilePath -> String
show :: MonitorFilePath -> String
$cshowList :: [MonitorFilePath] -> ShowS
showList :: [MonitorFilePath] -> ShowS
Show, (forall x. MonitorFilePath -> Rep MonitorFilePath x)
-> (forall x. Rep MonitorFilePath x -> MonitorFilePath)
-> Generic MonitorFilePath
forall x. Rep MonitorFilePath x -> MonitorFilePath
forall x. MonitorFilePath -> Rep MonitorFilePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorFilePath -> Rep MonitorFilePath x
from :: forall x. MonitorFilePath -> Rep MonitorFilePath x
$cto :: forall x. Rep MonitorFilePath x -> MonitorFilePath
to :: forall x. Rep MonitorFilePath x -> MonitorFilePath
Generic)
data MonitorKindFile
= FileExists
| FileModTime
| FileHashed
| FileNotExists
deriving (MonitorKindFile -> MonitorKindFile -> Bool
(MonitorKindFile -> MonitorKindFile -> Bool)
-> (MonitorKindFile -> MonitorKindFile -> Bool)
-> Eq MonitorKindFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonitorKindFile -> MonitorKindFile -> Bool
== :: MonitorKindFile -> MonitorKindFile -> Bool
$c/= :: MonitorKindFile -> MonitorKindFile -> Bool
/= :: MonitorKindFile -> MonitorKindFile -> Bool
Eq, Int -> MonitorKindFile -> ShowS
[MonitorKindFile] -> ShowS
MonitorKindFile -> String
(Int -> MonitorKindFile -> ShowS)
-> (MonitorKindFile -> String)
-> ([MonitorKindFile] -> ShowS)
-> Show MonitorKindFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorKindFile -> ShowS
showsPrec :: Int -> MonitorKindFile -> ShowS
$cshow :: MonitorKindFile -> String
show :: MonitorKindFile -> String
$cshowList :: [MonitorKindFile] -> ShowS
showList :: [MonitorKindFile] -> ShowS
Show, (forall x. MonitorKindFile -> Rep MonitorKindFile x)
-> (forall x. Rep MonitorKindFile x -> MonitorKindFile)
-> Generic MonitorKindFile
forall x. Rep MonitorKindFile x -> MonitorKindFile
forall x. MonitorKindFile -> Rep MonitorKindFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorKindFile -> Rep MonitorKindFile x
from :: forall x. MonitorKindFile -> Rep MonitorKindFile x
$cto :: forall x. Rep MonitorKindFile x -> MonitorKindFile
to :: forall x. Rep MonitorKindFile x -> MonitorKindFile
Generic)
data MonitorKindDir
= DirExists
| DirModTime
| DirNotExists
deriving (MonitorKindDir -> MonitorKindDir -> Bool
(MonitorKindDir -> MonitorKindDir -> Bool)
-> (MonitorKindDir -> MonitorKindDir -> Bool) -> Eq MonitorKindDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonitorKindDir -> MonitorKindDir -> Bool
== :: MonitorKindDir -> MonitorKindDir -> Bool
$c/= :: MonitorKindDir -> MonitorKindDir -> Bool
/= :: MonitorKindDir -> MonitorKindDir -> Bool
Eq, Int -> MonitorKindDir -> ShowS
[MonitorKindDir] -> ShowS
MonitorKindDir -> String
(Int -> MonitorKindDir -> ShowS)
-> (MonitorKindDir -> String)
-> ([MonitorKindDir] -> ShowS)
-> Show MonitorKindDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorKindDir -> ShowS
showsPrec :: Int -> MonitorKindDir -> ShowS
$cshow :: MonitorKindDir -> String
show :: MonitorKindDir -> String
$cshowList :: [MonitorKindDir] -> ShowS
showList :: [MonitorKindDir] -> ShowS
Show, (forall x. MonitorKindDir -> Rep MonitorKindDir x)
-> (forall x. Rep MonitorKindDir x -> MonitorKindDir)
-> Generic MonitorKindDir
forall x. Rep MonitorKindDir x -> MonitorKindDir
forall x. MonitorKindDir -> Rep MonitorKindDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorKindDir -> Rep MonitorKindDir x
from :: forall x. MonitorKindDir -> Rep MonitorKindDir x
$cto :: forall x. Rep MonitorKindDir x -> MonitorKindDir
to :: forall x. Rep MonitorKindDir x -> MonitorKindDir
Generic)
instance Binary MonitorFilePath
instance Binary MonitorKindFile
instance Binary MonitorKindDir
instance Structured MonitorFilePath
instance Structured MonitorKindFile
instance Structured MonitorKindDir
monitorFile :: FilePath -> MonitorFilePath
monitorFile :: String -> MonitorFilePath
monitorFile = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirNotExists
monitorFileHashed :: FilePath -> MonitorFilePath
monitorFileHashed :: String -> MonitorFilePath
monitorFileHashed = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileHashed MonitorKindDir
DirNotExists
monitorNonExistentFile :: FilePath -> MonitorFilePath
monitorNonExistentFile :: String -> MonitorFilePath
monitorNonExistentFile = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirNotExists
monitorFileExistence :: FilePath -> MonitorFilePath
monitorFileExistence :: String -> MonitorFilePath
monitorFileExistence = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileExists MonitorKindDir
DirNotExists
monitorDirectory :: FilePath -> MonitorFilePath
monitorDirectory :: String -> MonitorFilePath
monitorDirectory = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirModTime
monitorNonExistentDirectory :: FilePath -> MonitorFilePath
monitorNonExistentDirectory :: String -> MonitorFilePath
monitorNonExistentDirectory = String -> MonitorFilePath
monitorNonExistentFile
monitorDirectoryExistence :: FilePath -> MonitorFilePath
monitorDirectoryExistence :: String -> MonitorFilePath
monitorDirectoryExistence = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirExists
monitorFileOrDirectory :: FilePath -> MonitorFilePath
monitorFileOrDirectory :: String -> MonitorFilePath
monitorFileOrDirectory = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirModTime
monitorFileGlob :: RootedGlob -> MonitorFilePath
monitorFileGlob :: RootedGlob -> MonitorFilePath
monitorFileGlob = MonitorKindFile -> MonitorKindDir -> RootedGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileHashed MonitorKindDir
DirExists
monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
monitorFileGlobExistence = MonitorKindFile -> MonitorKindDir -> RootedGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileExists MonitorKindDir
DirExists
monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
monitorFileSearchPath :: [String] -> String -> [MonitorFilePath]
monitorFileSearchPath [String]
notFoundAtPaths String
foundAtPath =
String -> MonitorFilePath
monitorFile String
foundAtPath
MonitorFilePath -> [MonitorFilePath] -> [MonitorFilePath]
forall a. a -> [a] -> [a]
: (String -> MonitorFilePath) -> [String] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> MonitorFilePath
monitorNonExistentFile [String]
notFoundAtPaths
monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
monitorFileHashedSearchPath :: [String] -> String -> [MonitorFilePath]
monitorFileHashedSearchPath [String]
notFoundAtPaths String
foundAtPath =
String -> MonitorFilePath
monitorFileHashed String
foundAtPath
MonitorFilePath -> [MonitorFilePath] -> [MonitorFilePath]
forall a. a -> [a] -> [a]
: (String -> MonitorFilePath) -> [String] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> MonitorFilePath
monitorNonExistentFile [String]
notFoundAtPaths
instance Pretty RootedGlob where
pretty :: RootedGlob -> Doc
pretty (RootedGlob FilePathRoot
root Glob
pathglob) = FilePathRoot -> Doc
forall a. Pretty a => a -> Doc
pretty FilePathRoot
root Doc -> Doc -> Doc
Disp.<> Glob -> Doc
forall a. Pretty a => a -> Doc
pretty Glob
pathglob
instance Parsec RootedGlob where
parsec :: forall (m :: * -> *). CabalParsing m => m RootedGlob
parsec = do
FilePathRoot
root <- m FilePathRoot
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m FilePathRoot
parsec
case FilePathRoot
root of
FilePathRoot
FilePathRelative -> FilePathRoot -> Glob -> RootedGlob
RootedGlob FilePathRoot
root (Glob -> RootedGlob) -> m Glob -> m RootedGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Glob
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Glob
parsec
FilePathRoot
_ -> FilePathRoot -> Glob -> RootedGlob
RootedGlob FilePathRoot
root (Glob -> RootedGlob) -> m Glob -> m RootedGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Glob
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Glob
parsec m RootedGlob -> m RootedGlob -> m RootedGlob
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RootedGlob -> m RootedGlob
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePathRoot -> Glob -> RootedGlob
RootedGlob FilePathRoot
root Glob
GlobDirTrailing)
instance Pretty FilePathRoot where
pretty :: FilePathRoot -> Doc
pretty FilePathRoot
FilePathRelative = Doc
Disp.empty
pretty (FilePathRoot String
root) = String -> Doc
Disp.text String
root
pretty FilePathRoot
FilePathHomeDir = Char -> Doc
Disp.char Char
'~' Doc -> Doc -> Doc
Disp.<> Char -> Doc
Disp.char Char
'/'
instance Parsec FilePathRoot where
parsec :: forall (m :: * -> *). CabalParsing m => m FilePathRoot
parsec = m FilePathRoot
root m FilePathRoot -> m FilePathRoot -> m FilePathRoot
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m FilePathRoot -> m FilePathRoot
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m FilePathRoot
home m FilePathRoot -> m FilePathRoot -> m FilePathRoot
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m FilePathRoot -> m FilePathRoot
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m FilePathRoot
drive m FilePathRoot -> m FilePathRoot -> m FilePathRoot
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePathRoot -> m FilePathRoot
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePathRoot
FilePathRelative
where
root :: m FilePathRoot
root = String -> FilePathRoot
FilePathRoot String
"/" FilePathRoot -> m Char -> m FilePathRoot
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/'
home :: m FilePathRoot
home = FilePathRoot
FilePathHomeDir FilePathRoot -> m String -> m FilePathRoot
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"~/"
drive :: m FilePathRoot
drive = do
Char
dr <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy ((Char -> Bool) -> m Char) -> (Char -> Bool) -> m Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'/' m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'\\'
FilePathRoot -> m FilePathRoot
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FilePathRoot
FilePathRoot (Char -> Char
toUpper Char
dr Char -> ShowS
forall a. a -> [a] -> [a]
: String
":\\"))