{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE ExistentialQuantification #-}
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.Options
import           Development.IDE.Graph.Internal.Profile  (writeProfile)
import           Development.IDE.Graph.Internal.Rules
import           Development.IDE.Graph.Internal.Types


-- Placeholder to be the 'extra' if the user doesn't set it
data NonExportedType = NonExportedType

shakeNewDatabase :: ShakeOptions -> Rules () -> IO ShakeDatabase
shakeNewDatabase :: ShakeOptions -> Rules () -> IO ShakeDatabase
shakeNewDatabase ShakeOptions
opts Rules ()
rules = do
    let extra :: Dynamic
extra = forall a. a -> Maybe a -> a
fromMaybe (forall a. Typeable a => a -> Dynamic
toDyn NonExportedType
NonExportedType) 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
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> [Action ()] -> Database -> ShakeDatabase
ShakeDatabase (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 = forall a. Maybe [Key] -> ShakeDatabase -> [Action a] -> IO [a]
shakeRunDatabaseForKeys forall a. Maybe a
Nothing

-- | Returns the set of dirty keys annotated with their age (in # of builds)
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

-- | Returns the build number
shakeGetBuildStep :: ShakeDatabase -> IO Int
shakeGetBuildStep :: ShakeDatabase -> IO Int
shakeGetBuildStep (ShakeDatabase Int
_ [Action ()]
_ Database
db) = do
    Step Int
s <- forall a. TVar a -> IO a
readTVarIO forall a b. (a -> b) -> a -> b
$ Database -> TVar Step
databaseStep Database
db
    forall (m :: * -> *) a. Monad m => a -> m a
return Int
s

-- Only valid if we never pull on the results, which we don't
unvoid :: Functor m => m () -> m a
unvoid :: forall (m :: * -> *) a. Functor m => m () -> m a
unvoid = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => a
undefined

-- | Assumes that the database is not running a build
shakeRunDatabaseForKeys
    :: Maybe [Key]
      -- ^ Set of keys changed since last run. 'Nothing' means everything has changed
    -> 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> [a] -> [a]
drop Int
lenAs1) forall a b. (a -> b) -> a -> b
$ forall a. Database -> [Action a] -> IO [a]
runActions Database
db forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Functor m => m () -> m a
unvoid [Action ()]
as1 forall a. [a] -> [a] -> [a]
++ [Action a]
as2

-- | Given a 'ShakeDatabase', write an HTML profile to the given file about the latest run.
shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()
shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()
shakeProfileDatabase (ShakeDatabase Int
_ [Action ()]
_ Database
s) FilePath
file = FilePath -> Database -> IO ()
writeProfile FilePath
file Database
s

-- | Returns the clean keys in the database
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
    forall (m :: * -> *) a. Monad m => a -> m a
return [ (Key
k,Result
res) | (Key
k, Clean Result
res) <- [(Key, Status)]
keys]

-- | Returns the total count of edges in the build graph
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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Status -> Maybe Result
getResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Key, Status)]
keys
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> ResultDeps -> [Key]
getResultDepsDefault [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> ResultDeps
resultDeps) [Result]
ress

-- | Returns an approximation of the database keys,
--   annotated with how long ago (in # builds) they were visited
shakeGetDatabaseKeys :: ShakeDatabase -> IO [(Key, Int)]
shakeGetDatabaseKeys :: ShakeDatabase -> IO [(Key, Int)]
shakeGetDatabaseKeys (ShakeDatabase Int
_ [Action ()]
_ Database
db) = Database -> IO [(Key, Int)]
getKeysAndVisitAge Database
db