Cabal/src/Distribution/Simple/FileMonitor/Types.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2
   3 -- |
   4 -- Module: Distribution.Simple.FileMonitor.Types
   5 --
   6 -- Types for monitoring files and directories.
   7 module Distribution.Simple.FileMonitor.Types
   8   ( -- * Globs with respect to a root
   9     RootedGlob (..)
  10   , FilePathRoot (..)
  11   , Glob
  12
  13     -- * File monitoring
  14   , MonitorFilePath (..)
  15   , MonitorKindFile (..)
  16   , MonitorKindDir (..)
  17
  18     -- ** Utility constructors of t'MonitorFilePath'
  19   , monitorFile
  20   , monitorFileHashed
  21   , monitorNonExistentFile
  22   , monitorFileExistence
  23   , monitorDirectory
  24   , monitorNonExistentDirectory
  25   , monitorDirectoryExistence
  26   , monitorFileOrDirectory
  27   , monitorFileGlob
  28   , monitorFileGlobExistence
  29   , monitorFileSearchPath
  30   , monitorFileHashedSearchPath
  31   )
  32 where
  33
  34 import Distribution.Compat.Prelude
  35 import Distribution.Simple.Glob.Internal
  36   ( Glob (..)
  37   )
  38
  39 import qualified Distribution.Compat.CharParsing as P
  40 import Distribution.Parsec
  41 import Distribution.Pretty
  42 import qualified Text.PrettyPrint as Disp
  43
  44 --------------------------------------------------------------------------------
  45 -- Rooted globs.
  46 --
  47
  48 -- | A file path specified by globbing, relative
  49 -- to some root directory.
  50 data RootedGlob
  51   = RootedGlob
  52       FilePathRoot
  53       -- ^ what the glob is relative to
  54       Glob
  55       -- ^ the glob
  56   deriving (Eq, Show, Generic)
  57
  58 instance Binary RootedGlob
  59 instance Structured RootedGlob
  60
  61 data FilePathRoot
  62   = FilePathRelative
  63   | -- | e.g. @"/"@, @"c:\"@ or result of 'takeDrive'
  64     FilePathRoot FilePath
  65   | FilePathHomeDir
  66   deriving (Eq, Show, Generic)
  67
  68 instance Binary FilePathRoot
  69 instance Structured FilePathRoot
  70
  71 ------------------------------------------------------------------------------
  72 -- Types for specifying files to monitor
  73 --
  74
  75 -- | A description of a file (or set of files) to monitor for changes.
  76 --
  77 -- Where file paths are relative they are relative to a common directory
  78 -- (e.g. project root), not necessarily the process current directory.
  79 data MonitorFilePath
  80   = MonitorFile
  81       { monitorKindFile :: !MonitorKindFile
  82       , monitorKindDir :: !MonitorKindDir
  83       , monitorPath :: !FilePath
  84       }
  85   | MonitorFileGlob
  86       { monitorKindFile :: !MonitorKindFile
  87       , monitorKindDir :: !MonitorKindDir
  88       , monitorPathGlob :: !RootedGlob
  89       }
  90   deriving (Eq, Show, Generic)
  91
  92 data MonitorKindFile
  93   = FileExists
  94   | FileModTime
  95   | FileHashed
  96   | FileNotExists
  97   deriving (Eq, Show, Generic)
  98
  99 data MonitorKindDir
 100   = DirExists
 101   | DirModTime
 102   | DirNotExists
 103   deriving (Eq, Show, Generic)
 104
 105 instance Binary MonitorFilePath
 106 instance Binary MonitorKindFile
 107 instance Binary MonitorKindDir
 108
 109 instance Structured MonitorFilePath
 110 instance Structured MonitorKindFile
 111 instance Structured MonitorKindDir
 112
 113 -- | Monitor a single file for changes, based on its modification time.
 114 -- The monitored file is considered to have changed if it no longer
 115 -- exists or if its modification time has changed.
 116 monitorFile :: FilePath -> MonitorFilePath
 117 monitorFile = MonitorFile FileModTime DirNotExists
 118
 119 -- | Monitor a single file for changes, based on its modification time
 120 -- and content hash. The monitored file is considered to have changed if
 121 -- it no longer exists or if its modification time and content hash have
 122 -- changed.
 123 monitorFileHashed :: FilePath -> MonitorFilePath
 124 monitorFileHashed = MonitorFile FileHashed DirNotExists
 125
 126 -- | Monitor a single non-existent file for changes. The monitored file
 127 -- is considered to have changed if it exists.
 128 monitorNonExistentFile :: FilePath -> MonitorFilePath
 129 monitorNonExistentFile = MonitorFile FileNotExists DirNotExists
 130
 131 -- | Monitor a single file for existence only. The monitored file is
 132 -- considered to have changed if it no longer exists.
 133 monitorFileExistence :: FilePath -> MonitorFilePath
 134 monitorFileExistence = MonitorFile FileExists DirNotExists
 135
 136 -- | Monitor a single directory for changes, based on its modification
 137 -- time. The monitored directory is considered to have changed if it no
 138 -- longer exists or if its modification time has changed.
 139 monitorDirectory :: FilePath -> MonitorFilePath
 140 monitorDirectory = MonitorFile FileNotExists DirModTime
 141
 142 -- | Monitor a single non-existent directory for changes.  The monitored
 143 -- directory is considered to have changed if it exists.
 144 monitorNonExistentDirectory :: FilePath -> MonitorFilePath
 145 -- Just an alias for monitorNonExistentFile, since you can't
 146 -- tell the difference between a non-existent directory and
 147 -- a non-existent file :)
 148 monitorNonExistentDirectory = monitorNonExistentFile
 149
 150 -- | Monitor a single directory for existence. The monitored directory is
 151 -- considered to have changed only if it no longer exists.
 152 monitorDirectoryExistence :: FilePath -> MonitorFilePath
 153 monitorDirectoryExistence = MonitorFile FileNotExists DirExists
 154
 155 -- | Monitor a single file or directory for changes, based on its modification
 156 -- time. The monitored file is considered to have changed if it no longer
 157 -- exists or if its modification time has changed.
 158 monitorFileOrDirectory :: FilePath -> MonitorFilePath
 159 monitorFileOrDirectory = MonitorFile FileModTime DirModTime
 160
 161 -- | Monitor a set of files (or directories) identified by a file glob.
 162 -- The monitored glob is considered to have changed if the set of files
 163 -- matching the glob changes (i.e. creations or deletions), or for files if the
 164 -- modification time and content hash of any matching file has changed.
 165 monitorFileGlob :: RootedGlob -> MonitorFilePath
 166 monitorFileGlob = MonitorFileGlob FileHashed DirExists
 167
 168 -- | Monitor a set of files (or directories) identified by a file glob for
 169 -- existence only. The monitored glob is considered to have changed if the set
 170 -- of files matching the glob changes (i.e. creations or deletions).
 171 monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
 172 monitorFileGlobExistence = MonitorFileGlob FileExists DirExists
 173
 174 -- | Creates a list of files to monitor when you search for a file which
 175 -- unsuccessfully looked in @notFoundAtPaths@ before finding it at
 176 -- @foundAtPath@.
 177 monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
 178 monitorFileSearchPath notFoundAtPaths foundAtPath =
 179   monitorFile foundAtPath
 180     : map monitorNonExistentFile notFoundAtPaths
 181
 182 -- | Similar to 'monitorFileSearchPath', but also instructs us to
 183 -- monitor the hash of the found file.
 184 monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
 185 monitorFileHashedSearchPath notFoundAtPaths foundAtPath =
 186   monitorFileHashed foundAtPath
 187     : map monitorNonExistentFile notFoundAtPaths
 188
 189 ------------------------------------------------------------------------------
 190 -- Parsing & pretty-printing
 191 --
 192
 193 instance Pretty RootedGlob where
 194   pretty (RootedGlob root pathglob) = pretty root Disp.<> pretty pathglob
 195
 196 instance Parsec RootedGlob where
 197   parsec = do
 198     root <- parsec
 199     case root of
 200       FilePathRelative -> RootedGlob root <$> parsec
 201       _ -> RootedGlob root <$> parsec <|> pure (RootedGlob root GlobDirTrailing)
 202
 203 instance Pretty FilePathRoot where
 204   pretty FilePathRelative = Disp.empty
 205   pretty (FilePathRoot root) = Disp.text root
 206   pretty FilePathHomeDir = Disp.char '~' Disp.<> Disp.char '/'
 207
 208 instance Parsec FilePathRoot where
 209   parsec = root <|> P.try home <|> P.try drive <|> pure FilePathRelative
 210     where
 211       root = FilePathRoot "/" <$ P.char '/'
 212       home = FilePathHomeDir <$ P.string "~/"
 213       drive = do
 214         dr <- P.satisfy $ \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')
 215         _ <- P.char ':'
 216         _ <- P.char '/' <|> P.char '\\'
 217         return (FilePathRoot (toUpper dr : ":\\"))