Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
7ff841eb
Commit
7ff841eb
authored
Aug 06, 2017
by
Andrey Mokhov
Browse files
Move DirectoryContents oracle to the library
See
#347
parent
5e1d004c
Changes
8
Hide whitespace changes
Inline
Side-by-side
hadrian.cabal
View file @
7ff841eb
...
...
@@ -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
...
...
src/Base.hs
View file @
7ff841eb
...
...
@@ -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
]
...
...
src/Oracles/DirectoryContents.hs
→
src/
Hadrian/
Oracles/DirectoryContents.hs
View file @
7ff841eb
{-# 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
src/Hadrian/Utilities.hs
0 → 100644
View file @
7ff841eb
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
-/-
src/Rules/Install.hs
View file @
7ff841eb
{-# 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
...
...
src/Rules/Oracles.hs
View file @
7ff841eb
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
src/Rules/SourceDist.hs
View file @
7ff841eb
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
...
...
src/Util.hs
View file @
7ff841eb
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment