Commit 7ff841eb authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Move DirectoryContents oracle to the library

See #347
parent 5e1d004c
......@@ -28,12 +28,13 @@ executable hadrian
, GHC
, Hadrian.Expression
, Hadrian.Oracles.ArgsHash
, Hadrian.Oracles.DirectoryContents
, Hadrian.Target
, Hadrian.Utilities
, Oracles.Config
, Oracles.Config.Flag
, Oracles.Config.Setting
, Oracles.Dependencies
, Oracles.DirectoryContents
, Oracles.ModuleFiles
, Oracles.PackageData
, Oracles.Path
......
......@@ -33,6 +33,7 @@ import Data.Semigroup
import Development.Shake hiding (parallel, unit, (*>), Normal)
import Development.Shake.Classes
import Development.Shake.FilePath
import Hadrian.Utilities
import System.Console.ANSI
import System.IO
import System.Info
......@@ -72,19 +73,6 @@ replaceWhen p to = map (\from -> if p from then to else from)
quote :: String -> String
quote s = "'" ++ s ++ "'"
-- | Normalise a path and convert all path separators to @/@, even on Windows.
unifyPath :: FilePath -> FilePath
unifyPath = toStandard . normaliseEx
-- | Combine paths with a forward slash regardless of platform.
(-/-) :: FilePath -> FilePath -> FilePath
"" -/- b = b
a -/- b
| last a == '/' = a ++ b
| otherwise = a ++ '/' : b
infixr 6 -/-
-- Explicit definition to avoid dependency on Data.List.Ordered
-- | Difference of two ordered lists.
minusOrd :: Ord a => [a] -> [a] -> [a]
......
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}
module Oracles.DirectoryContents (
module Hadrian.Oracles.DirectoryContents (
directoryContents, directoryContentsOracle, Match (..), matchAll
) where
import System.Directory.Extra
import Control.Monad
import Development.Shake
import Development.Shake.Classes
import GHC.Generics
import System.Directory.Extra
import Base
import Hadrian.Utilities
newtype DirectoryContents = DirectoryContents (Match, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
......@@ -14,6 +17,10 @@ newtype DirectoryContents = DirectoryContents (Match, FilePath)
data Match = Test FilePattern | Not Match | And [Match] | Or [Match]
deriving (Generic, Eq, Show, Typeable)
instance Binary Match
instance Hashable Match
instance NFData Match
-- | A 'Match' expression that always evaluates to 'True' (i.e. always matches).
matchAll :: Match
matchAll = And []
......@@ -30,11 +37,8 @@ matches (Or ms) f = any (`matches` f) ms
directoryContents :: Match -> FilePath -> Action [FilePath]
directoryContents expr dir = askOracle $ DirectoryContents (expr, dir)
-- | This oracle answers 'directoryContents' queries and tracks the results.
directoryContentsOracle :: Rules ()
directoryContentsOracle = void $
addOracle $ \(DirectoryContents (expr, dir)) -> liftIO $ map unifyPath .
filter (matches expr) <$> listFilesInside (return . matches expr) dir
instance Binary Match
instance Hashable Match
instance NFData Match
module Hadrian.Utilities (
-- * FilePath manipulation
unifyPath, (-/-)
) where
import Development.Shake.FilePath
-- | Normalise a path and convert all path separators to @/@, even on Windows.
unifyPath :: FilePath -> FilePath
unifyPath = toStandard . normaliseEx
-- | Combine paths with a forward slash regardless of platform.
(-/-) :: FilePath -> FilePath -> FilePath
"" -/- b = b
a -/- b
| last a == '/' = a ++ b
| otherwise = a ++ '/' : b
infixr 6 -/-
{-# LANGUAGE FlexibleContexts #-}
module Rules.Install (installRules) where
import Hadrian.Oracles.DirectoryContents
import Base
import Target
import Context
......@@ -16,7 +18,6 @@ import Rules.Generate
import Settings.Packages.Rts
import Oracles.Config.Setting
import Oracles.Dependencies
import Oracles.DirectoryContents
import Oracles.Path
import qualified System.Directory as IO
......
module Rules.Oracles (oracleRules) where
import qualified Hadrian.Oracles.ArgsHash
import qualified Hadrian.Oracles.DirectoryContents
import Base
import qualified Oracles.Config
import qualified Oracles.Dependencies
import qualified Oracles.DirectoryContents
import qualified Oracles.ModuleFiles
import qualified Oracles.PackageData
import qualified Oracles.Path
......@@ -15,9 +15,9 @@ import Settings
oracleRules :: Rules ()
oracleRules = do
Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
Hadrian.Oracles.DirectoryContents.directoryContentsOracle
Oracles.Config.configOracle
Oracles.Dependencies.dependenciesOracles
Oracles.DirectoryContents.directoryContentsOracle
Oracles.ModuleFiles.moduleFilesOracle
Oracles.PackageData.packageDataOracle
Oracles.Path.pathOracle
module Rules.SourceDist (sourceDistRules) where
import Hadrian.Oracles.DirectoryContents
import Base
import Builder
import Oracles.Config.Setting
import Oracles.DirectoryContents
import Rules.Clean
import UserSettings
import Util
......
......@@ -12,13 +12,13 @@ import qualified System.IO as IO
import qualified Control.Exception.Base as IO
import Hadrian.Oracles.ArgsHash
import Hadrian.Oracles.DirectoryContents
import Base
import CmdLineFlag
import Context
import Expression
import GHC
import Oracles.DirectoryContents
import Oracles.Path
import Oracles.Config.Setting
import Settings
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment