module Development.IDE.Graph.Database(
ShakeDatabase,
ShakeValue,
shakeNewDatabase,
shakeRunDatabase,
shakeRunDatabaseForKeys,
shakeProfileDatabase,
shakeGetBuildStep,
shakeGetDatabaseKeys,
shakeGetDirtySet,
shakeGetCleanKeys
,shakeGetBuildEdges) where
import Control.Concurrent.STM.Stats (readTVarIO)
import Data.Dynamic
import Data.Maybe
import Development.IDE.Graph.Classes ()
import Development.IDE.Graph.Internal.Action
import Development.IDE.Graph.Internal.Database
import Development.IDE.Graph.Internal.Key
import Development.IDE.Graph.Internal.Options
import Development.IDE.Graph.Internal.Profile (writeProfile)
import Development.IDE.Graph.Internal.Rules
import Development.IDE.Graph.Internal.Types
data NonExportedType = NonExportedType
shakeNewDatabase :: ShakeOptions -> Rules () -> IO ShakeDatabase
shakeNewDatabase :: ShakeOptions -> Rules () -> IO ShakeDatabase
shakeNewDatabase ShakeOptions
opts Rules ()
rules = do
let extra :: Dynamic
extra = Dynamic -> Maybe Dynamic -> Dynamic
forall a. a -> Maybe a -> a
fromMaybe (NonExportedType -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn NonExportedType
NonExportedType) (Maybe Dynamic -> Dynamic) -> Maybe Dynamic -> Dynamic
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Dynamic
shakeExtra ShakeOptions
opts
(TheRules
theRules, [Action ()]
actions) <- Dynamic -> Rules () -> IO (TheRules, [Action ()])
runRules Dynamic
extra Rules ()
rules
Database
db <- Dynamic -> TheRules -> IO Database
newDatabase Dynamic
extra TheRules
theRules
ShakeDatabase -> IO ShakeDatabase
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShakeDatabase -> IO ShakeDatabase)
-> ShakeDatabase -> IO ShakeDatabase
forall a b. (a -> b) -> a -> b
$ Int -> [Action ()] -> Database -> ShakeDatabase
ShakeDatabase ([Action ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Action ()]
actions) [Action ()]
actions Database
db
shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO [a]
shakeRunDatabase :: forall a. ShakeDatabase -> [Action a] -> IO [a]
shakeRunDatabase = Maybe [Key] -> ShakeDatabase -> [Action a] -> IO [a]
forall a. Maybe [Key] -> ShakeDatabase -> [Action a] -> IO [a]
shakeRunDatabaseForKeys Maybe [Key]
forall a. Maybe a
Nothing
shakeGetDirtySet :: ShakeDatabase -> IO [(Key, Int)]
shakeGetDirtySet :: ShakeDatabase -> IO [(Key, Int)]
shakeGetDirtySet (ShakeDatabase Int
_ [Action ()]
_ Database
db) =
Database -> IO [(Key, Int)]
Development.IDE.Graph.Internal.Database.getDirtySet Database
db
shakeGetBuildStep :: ShakeDatabase -> IO Int
shakeGetBuildStep :: ShakeDatabase -> IO Int
shakeGetBuildStep (ShakeDatabase Int
_ [Action ()]
_ Database
db) = do
Step Int
s <- TVar Step -> IO Step
forall a. TVar a -> IO a
readTVarIO (TVar Step -> IO Step) -> TVar Step -> IO Step
forall a b. (a -> b) -> a -> b
$ Database -> TVar Step
databaseStep Database
db
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
unvoid :: Functor m => m () -> m a
unvoid :: forall (m :: * -> *) a. Functor m => m () -> m a
unvoid = (() -> a) -> m () -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> a
forall a. HasCallStack => a
undefined
shakeRunDatabaseForKeys
:: Maybe [Key]
-> ShakeDatabase
-> [Action a]
-> IO [a]
shakeRunDatabaseForKeys :: forall a. Maybe [Key] -> ShakeDatabase -> [Action a] -> IO [a]
shakeRunDatabaseForKeys Maybe [Key]
keysChanged (ShakeDatabase Int
lenAs1 [Action ()]
as1 Database
db) [Action a]
as2 = do
Database -> Maybe [Key] -> IO ()
incDatabase Database
db Maybe [Key]
keysChanged
([a] -> [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
lenAs1) (IO [a] -> IO [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ Database -> [Action a] -> IO [a]
forall a. Database -> [Action a] -> IO [a]
runActions Database
db ([Action a] -> IO [a]) -> [Action a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ (Action () -> Action a) -> [Action ()] -> [Action a]
forall a b. (a -> b) -> [a] -> [b]
map Action () -> Action a
forall (m :: * -> *) a. Functor m => m () -> m a
unvoid [Action ()]
as1 [Action a] -> [Action a] -> [Action a]
forall a. [a] -> [a] -> [a]
++ [Action a]
as2
shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()
shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()
shakeProfileDatabase (ShakeDatabase Int
_ [Action ()]
_ Database
s) FilePath
file = FilePath -> Database -> IO ()
writeProfile FilePath
file Database
s
shakeGetCleanKeys :: ShakeDatabase -> IO [(Key, Result )]
shakeGetCleanKeys :: ShakeDatabase -> IO [(Key, Result)]
shakeGetCleanKeys (ShakeDatabase Int
_ [Action ()]
_ Database
db) = do
[(Key, Status)]
keys <- Database -> IO [(Key, Status)]
getDatabaseValues Database
db
[(Key, Result)] -> IO [(Key, Result)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Key
k,Result
res) | (Key
k, Clean Result
res) <- [(Key, Status)]
keys]
shakeGetBuildEdges :: ShakeDatabase -> IO Int
shakeGetBuildEdges :: ShakeDatabase -> IO Int
shakeGetBuildEdges (ShakeDatabase Int
_ [Action ()]
_ Database
db) = do
[(Key, Status)]
keys <- Database -> IO [(Key, Status)]
getDatabaseValues Database
db
let ress :: [Result]
ress = ((Key, Status) -> Maybe Result) -> [(Key, Status)] -> [Result]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Status -> Maybe Result
getResult (Status -> Maybe Result)
-> ((Key, Status) -> Status) -> (Key, Status) -> Maybe Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Status
forall a b. (a, b) -> b
snd) [(Key, Status)]
keys
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Result -> Int) -> [Result] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (KeySet -> Int
lengthKeySet (KeySet -> Int) -> (Result -> KeySet) -> Result -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeySet -> ResultDeps -> KeySet
getResultDepsDefault KeySet
forall a. Monoid a => a
mempty (ResultDeps -> KeySet)
-> (Result -> ResultDeps) -> Result -> KeySet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> ResultDeps
resultDeps) [Result]
ress
shakeGetDatabaseKeys :: ShakeDatabase -> IO [(Key, Int)]
shakeGetDatabaseKeys :: ShakeDatabase -> IO [(Key, Int)]
shakeGetDatabaseKeys (ShakeDatabase Int
_ [Action ()]
_ Database
db) = Database -> IO [(Key, Int)]
getKeysAndVisitAge Database
db