{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module: Distribution.Simple.FileMonitor.Types
--
-- Types for monitoring files and directories.
module Distribution.Simple.FileMonitor.Types
  ( -- * Globs with respect to a root
    RootedGlob (..)
  , FilePathRoot (..)
  , Glob

    -- * File monitoring
  , MonitorFilePath (..)
  , MonitorKindFile (..)
  , MonitorKindDir (..)

    -- ** Utility constructors of t'MonitorFilePath'
  , 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

--------------------------------------------------------------------------------
-- Rooted globs.
--

-- | A file path specified by globbing, relative
-- to some root directory.
data RootedGlob
  = RootedGlob
      FilePathRoot
      -- ^ what the glob is relative to
      Glob
      -- ^ the 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
  | -- | e.g. @"/"@, @"c:\"@ or result of 'takeDrive'
    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

------------------------------------------------------------------------------
-- Types for specifying files to monitor
--

-- | A description of a file (or set of files) to monitor for changes.
--
-- Where file paths are relative they are relative to a common directory
-- (e.g. project root), not necessarily the process current directory.
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

-- | Monitor a single file for changes, based on its modification time.
-- The monitored file is considered to have changed if it no longer
-- exists or if its modification time has changed.
monitorFile :: FilePath -> MonitorFilePath
monitorFile :: String -> MonitorFilePath
monitorFile = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirNotExists

-- | Monitor a single file for changes, based on its modification time
-- and content hash. The monitored file is considered to have changed if
-- it no longer exists or if its modification time and content hash have
-- changed.
monitorFileHashed :: FilePath -> MonitorFilePath
monitorFileHashed :: String -> MonitorFilePath
monitorFileHashed = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileHashed MonitorKindDir
DirNotExists

-- | Monitor a single non-existent file for changes. The monitored file
-- is considered to have changed if it exists.
monitorNonExistentFile :: FilePath -> MonitorFilePath
monitorNonExistentFile :: String -> MonitorFilePath
monitorNonExistentFile = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirNotExists

-- | Monitor a single file for existence only. The monitored file is
-- considered to have changed if it no longer exists.
monitorFileExistence :: FilePath -> MonitorFilePath
monitorFileExistence :: String -> MonitorFilePath
monitorFileExistence = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileExists MonitorKindDir
DirNotExists

-- | Monitor a single directory for changes, based on its modification
-- time. The monitored directory is considered to have changed if it no
-- longer exists or if its modification time has changed.
monitorDirectory :: FilePath -> MonitorFilePath
monitorDirectory :: String -> MonitorFilePath
monitorDirectory = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirModTime

-- | Monitor a single non-existent directory for changes.  The monitored
-- directory is considered to have changed if it exists.
monitorNonExistentDirectory :: FilePath -> MonitorFilePath
-- Just an alias for monitorNonExistentFile, since you can't
-- tell the difference between a non-existent directory and
-- a non-existent file :)
monitorNonExistentDirectory :: String -> MonitorFilePath
monitorNonExistentDirectory = String -> MonitorFilePath
monitorNonExistentFile

-- | Monitor a single directory for existence. The monitored directory is
-- considered to have changed only if it no longer exists.
monitorDirectoryExistence :: FilePath -> MonitorFilePath
monitorDirectoryExistence :: String -> MonitorFilePath
monitorDirectoryExistence = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirExists

-- | Monitor a single file or directory for changes, based on its modification
-- time. The monitored file is considered to have changed if it no longer
-- exists or if its modification time has changed.
monitorFileOrDirectory :: FilePath -> MonitorFilePath
monitorFileOrDirectory :: String -> MonitorFilePath
monitorFileOrDirectory = MonitorKindFile -> MonitorKindDir -> String -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirModTime

-- | Monitor a set of files (or directories) identified by a file glob.
-- The monitored glob is considered to have changed if the set of files
-- matching the glob changes (i.e. creations or deletions), or for files if the
-- modification time and content hash of any matching file has changed.
monitorFileGlob :: RootedGlob -> MonitorFilePath
monitorFileGlob :: RootedGlob -> MonitorFilePath
monitorFileGlob = MonitorKindFile -> MonitorKindDir -> RootedGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileHashed MonitorKindDir
DirExists

-- | Monitor a set of files (or directories) identified by a file glob for
-- existence only. The monitored glob is considered to have changed if the set
-- of files matching the glob changes (i.e. creations or deletions).
monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
monitorFileGlobExistence = MonitorKindFile -> MonitorKindDir -> RootedGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileExists MonitorKindDir
DirExists

-- | Creates a list of files to monitor when you search for a file which
-- unsuccessfully looked in @notFoundAtPaths@ before finding it at
-- @foundAtPath@.
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

-- | Similar to 'monitorFileSearchPath', but also instructs us to
-- monitor the hash of the found file.
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

------------------------------------------------------------------------------
-- Parsing & pretty-printing
--

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
    root <- m FilePathRoot
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m FilePathRoot
parsec
    case 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
        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')
        _ <- P.char ':'
        _ <- P.char '/' <|> P.char '\\'
        return (FilePathRoot (toUpper dr : ":\\"))