{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}
{-# LANGUAGE ConstraintKinds, TupleSections, ViewPatterns #-}
{-# LANGUAGE TypeFamilies, NamedFieldPuns #-}

module Development.Shake.Internal.Core.Run(
    RunState,
    open,
    reset,
    run,
    shakeRunAfter,
    liveFilesState,
    profileState,
    errorsState
    ) where

import Control.Exception
import Data.Tuple.Extra
import Control.Concurrent.Extra hiding (withNumCapabilities)
import Development.Shake.Internal.Core.Database
import Control.Monad.IO.Class
import General.Binary
import Development.Shake.Classes
import Development.Shake.Internal.Core.Storage
import Development.Shake.Internal.Core.Build
import Development.Shake.Internal.History.Shared
import Development.Shake.Internal.History.Cloud
import qualified General.TypeMap as TMap
import Control.Monad.Extra
import Data.Typeable
import Numeric.Extra
import Data.List.Extra
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import Data.Dynamic
import Data.Maybe
import Data.IORef.Extra
import System.Directory
import System.Time.Extra
import qualified Data.ByteString as BS

import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.Core.Rules
import General.Pool
import Development.Shake.Internal.Progress
import Development.Shake.Internal.Value
import Development.Shake.Internal.Profile
import Development.Shake.Internal.Options
import Development.Shake.Internal.Errors
import General.Timing
import General.Thread
import General.Extra
import General.Cleanup
import Data.Monoid
import Prelude


---------------------------------------------------------------------
-- MAKE

data RunState = RunState
    {RunState -> ShakeOptions
opts :: ShakeOptions
    ,RunState -> HashMap TypeRep BuiltinRule
builtinRules :: Map.HashMap TypeRep BuiltinRule
    ,RunState -> Map UserRuleVersioned
userRules :: TMap.Map UserRuleVersioned
    ,RunState -> Database
database :: Database
    ,RunState -> FilePath
curdir :: FilePath
    ,RunState -> Maybe Shared
shared :: Maybe Shared
    ,RunState -> Maybe Cloud
cloud :: Maybe Cloud
    ,RunState -> [(Stack, Action ())]
actions :: [(Stack, Action ())]
    }


open :: Cleanup -> ShakeOptions -> Rules () -> IO RunState
open :: Cleanup -> ShakeOptions -> Rules () -> IO RunState
open Cleanup
cleanup ShakeOptions
opts Rules ()
rs = ShakeOptions
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO RunState)
-> IO RunState
forall a.
ShakeOptions
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO a)
-> IO a
withInit ShakeOptions
opts ((ShakeOptions
  -> (IO FilePath -> IO ())
  -> (Verbosity -> FilePath -> IO ())
  -> IO RunState)
 -> IO RunState)
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO RunState)
-> IO RunState
forall a b. (a -> b) -> a -> b
$ \opts :: ShakeOptions
opts@ShakeOptions{Bool
Int
FilePath
[FilePath]
[(FilePath, FilePath)]
[(Rebuild, FilePath)]
[CmdOption]
Maybe Seconds
Maybe FilePath
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
FilePath -> FilePath -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> FilePath -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> FilePath -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [FilePath]
shakeShare :: ShakeOptions -> Maybe FilePath
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [FilePath]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(FilePath, FilePath)]
shakeRebuild :: ShakeOptions -> [(Rebuild, FilePath)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [FilePath]
shakeLintIgnore :: ShakeOptions -> [FilePath]
shakeLintInside :: ShakeOptions -> [FilePath]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [FilePath]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> FilePath
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: Verbosity -> FilePath -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [FilePath]
shakeShare :: Maybe FilePath
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [FilePath]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(FilePath, FilePath)]
shakeRebuild :: [(Rebuild, FilePath)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [FilePath]
shakeLintIgnore :: [FilePath]
shakeLintInside :: [FilePath]
shakeLint :: Maybe Lint
shakeReport :: [FilePath]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: FilePath
shakeThreads :: Int
shakeFiles :: FilePath
..} IO FilePath -> IO ()
diagnostic Verbosity -> FilePath -> IO ()
_ -> do
    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"Starting run"
    SRules{[(Stack, Action ())]
actions :: forall (list :: * -> *). SRules list -> list (Stack, Action ())
actions :: [(Stack, Action ())]
actions, HashMap TypeRep BuiltinRule
builtinRules :: forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
builtinRules :: HashMap TypeRep BuiltinRule
builtinRules, Map UserRuleVersioned
userRules :: forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules :: Map UserRuleVersioned
userRules} <- ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs

    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Number of actions = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([(Stack, Action ())] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Stack, Action ())]
actions)
    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Number of builtin rules = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (HashMap TypeRep BuiltinRule -> Int
forall k v. HashMap k v -> Int
Map.size HashMap TypeRep BuiltinRule
builtinRules) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [TypeRep] -> FilePath
forall a. Show a => a -> FilePath
show (HashMap TypeRep BuiltinRule -> [TypeRep]
forall k v. HashMap k v -> [k]
Map.keys HashMap TypeRep BuiltinRule
builtinRules)
    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Number of user rule types = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Map UserRuleVersioned -> Int
forall (f :: * -> *). Map f -> Int
TMap.size Map UserRuleVersioned
userRules)
    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Number of user rules = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((forall a. UserRuleVersioned a -> Int)
-> Map UserRuleVersioned -> [Int]
forall (f :: * -> *) b. (forall a. f a -> b) -> Map f -> [b]
TMap.toList (UserRule a -> Int
forall a. UserRule a -> Int
userRuleSize (UserRule a -> Int)
-> (UserRuleVersioned a -> UserRule a)
-> UserRuleVersioned a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserRuleVersioned a -> UserRule a
forall a. UserRuleVersioned a -> UserRule a
userRuleContents) Map UserRuleVersioned
userRules))

    HashMap TypeRep Dynamic -> IO ()
checkShakeExtra HashMap TypeRep Dynamic
shakeExtra
    FilePath
curdir <- IO FilePath
getCurrentDirectory

    Database
database <- Cleanup
-> ShakeOptions
-> (IO FilePath -> IO ())
-> HashMap TypeRep BuiltinRule
-> IO Database
usingDatabase Cleanup
cleanup ShakeOptions
opts IO FilePath -> IO ()
diagnostic HashMap TypeRep BuiltinRule
builtinRules
    (Maybe Shared
shared, Maybe Cloud
cloud) <- Database
-> ShakeOptions
-> HashMap TypeRep BuiltinRule
-> IO (Maybe Shared, Maybe Cloud)
forall k v.
DatabasePoly k v
-> ShakeOptions
-> HashMap TypeRep BuiltinRule
-> IO (Maybe Shared, Maybe Cloud)
loadSharedCloud Database
database ShakeOptions
opts HashMap TypeRep BuiltinRule
builtinRules
    RunState -> IO RunState
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunState :: ShakeOptions
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> Database
-> FilePath
-> Maybe Shared
-> Maybe Cloud
-> [(Stack, Action ())]
-> RunState
RunState{FilePath
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
cloud :: Maybe Cloud
shared :: Maybe Shared
database :: Database
curdir :: FilePath
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
actions :: [(Stack, Action ())]
opts :: ShakeOptions
actions :: [(Stack, Action ())]
cloud :: Maybe Cloud
shared :: Maybe Shared
curdir :: FilePath
database :: Database
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
opts :: ShakeOptions
..}


-- Prepare for a fresh run by changing Result to Loaded
reset :: RunState -> IO ()
reset :: RunState -> IO ()
reset RunState{FilePath
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
actions :: [(Stack, Action ())]
cloud :: Maybe Cloud
shared :: Maybe Shared
curdir :: FilePath
database :: Database
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
opts :: ShakeOptions
actions :: RunState -> [(Stack, Action ())]
cloud :: RunState -> Maybe Cloud
shared :: RunState -> Maybe Shared
curdir :: RunState -> FilePath
database :: RunState -> Database
userRules :: RunState -> Map UserRuleVersioned
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
opts :: RunState -> ShakeOptions
..} = Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
database (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Database -> (Status -> Status) -> Locked ()
forall k v. DatabasePoly k v -> (v -> v) -> Locked ()
modifyAllMem Database
database Status -> Status
f
    where
        f :: Status -> Status
f (Ready Result (Value, OneShot BS_Store)
r) = Result (OneShot BS_Store) -> Status
Loaded ((Value, OneShot BS_Store) -> OneShot BS_Store
forall a b. (a, b) -> b
snd ((Value, OneShot BS_Store) -> OneShot BS_Store)
-> Result (Value, OneShot BS_Store) -> Result (OneShot BS_Store)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result (Value, OneShot BS_Store)
r)
        f (Failed SomeException
_ OneShot (Maybe (Result (OneShot BS_Store)))
x) = Status
-> (Result (OneShot BS_Store) -> Status)
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Status
Missing Result (OneShot BS_Store) -> Status
Loaded OneShot (Maybe (Result (OneShot BS_Store)))
x
        f (Running NoShow
  (Either SomeException (Result (Value, OneShot BS_Store))
   -> Locked ())
_ OneShot (Maybe (Result (OneShot BS_Store)))
x) = Status
-> (Result (OneShot BS_Store) -> Status)
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Status
Missing Result (OneShot BS_Store) -> Status
Loaded OneShot (Maybe (Result (OneShot BS_Store)))
x -- shouldn't ever happen, but Loaded is least worst
        f Status
x = Status
x


run :: RunState -> Bool -> [Action ()] -> IO [IO ()]
run :: RunState -> Bool -> [Action ()] -> IO [IO ()]
run RunState{FilePath
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
actions :: [(Stack, Action ())]
cloud :: Maybe Cloud
shared :: Maybe Shared
curdir :: FilePath
database :: Database
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
opts :: ShakeOptions
actions :: RunState -> [(Stack, Action ())]
cloud :: RunState -> Maybe Cloud
shared :: RunState -> Maybe Shared
curdir :: RunState -> FilePath
database :: RunState -> Database
userRules :: RunState -> Map UserRuleVersioned
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
opts :: RunState -> ShakeOptions
..} Bool
oneshot [Action ()]
actions2 =
    ShakeOptions
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO [IO ()])
-> IO [IO ()]
forall a.
ShakeOptions
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO a)
-> IO a
withInit ShakeOptions
opts ((ShakeOptions
  -> (IO FilePath -> IO ())
  -> (Verbosity -> FilePath -> IO ())
  -> IO [IO ()])
 -> IO [IO ()])
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO [IO ()])
-> IO [IO ()]
forall a b. (a -> b) -> a -> b
$ \opts :: ShakeOptions
opts@ShakeOptions{Bool
Int
FilePath
[FilePath]
[(FilePath, FilePath)]
[(Rebuild, FilePath)]
[CmdOption]
Maybe Seconds
Maybe FilePath
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
FilePath -> FilePath -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> FilePath -> IO ()
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: Verbosity -> FilePath -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [FilePath]
shakeShare :: Maybe FilePath
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [FilePath]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(FilePath, FilePath)]
shakeRebuild :: [(Rebuild, FilePath)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [FilePath]
shakeLintIgnore :: [FilePath]
shakeLintInside :: [FilePath]
shakeLint :: Maybe Lint
shakeReport :: [FilePath]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: FilePath
shakeThreads :: Int
shakeFiles :: FilePath
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> FilePath -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [FilePath]
shakeShare :: ShakeOptions -> Maybe FilePath
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [FilePath]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(FilePath, FilePath)]
shakeRebuild :: ShakeOptions -> [(Rebuild, FilePath)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [FilePath]
shakeLintIgnore :: ShakeOptions -> [FilePath]
shakeLintInside :: ShakeOptions -> [FilePath]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [FilePath]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> FilePath
..} IO FilePath -> IO ()
diagnostic Verbosity -> FilePath -> IO ()
output -> do

        -- timings are a bit delicate, we want to make sure we clear them before we leave (so each run is fresh)
        -- but we also want to only print them if there is no exception, and have to caputre them before we clear them
        -- we use this variable to stash them away, then print after the exception handling block
        IORef (Maybe [FilePath])
timingsToShow <- Maybe [FilePath] -> IO (IORef (Maybe [FilePath]))
forall a. a -> IO (IORef a)
newIORef Maybe [FilePath]
forall a. Maybe a
Nothing

        [IO ()]
res <- (Cleanup -> IO [IO ()]) -> IO [IO ()]
forall a. (Cleanup -> IO a) -> IO a
withCleanup ((Cleanup -> IO [IO ()]) -> IO [IO ()])
-> (Cleanup -> IO [IO ()]) -> IO [IO ()]
forall a b. (a -> b) -> a -> b
$ \Cleanup
cleanup -> do
            Cleanup -> IO () -> IO ReleaseKey
register Cleanup
cleanup (IO () -> IO ReleaseKey) -> IO () -> IO ReleaseKey
forall a b. (a -> b) -> a -> b
$ do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
shakeTimings Bool -> Bool -> Bool
&& Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Info) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    IORef (Maybe [FilePath]) -> Maybe [FilePath] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe [FilePath])
timingsToShow (Maybe [FilePath] -> IO ())
-> ([FilePath] -> Maybe [FilePath]) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath]
getTimings
                IO ()
resetTimings

            IO Seconds
start <- IO (IO Seconds)
offsetTime
            IORef (Maybe (FilePath, ShakeException))
except <- Maybe (FilePath, ShakeException)
-> IO (IORef (Maybe (FilePath, ShakeException)))
forall a. a -> IO (IORef a)
newIORef (Maybe (FilePath, ShakeException)
forall a. Maybe a
Nothing :: Maybe (String, ShakeException))
            let getFailure :: IO (Maybe FilePath)
getFailure = ((FilePath, ShakeException) -> FilePath)
-> Maybe (FilePath, ShakeException) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, ShakeException) -> FilePath
forall a b. (a, b) -> a
fst (Maybe (FilePath, ShakeException) -> Maybe FilePath)
-> IO (Maybe (FilePath, ShakeException)) -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Maybe (FilePath, ShakeException))
-> IO (Maybe (FilePath, ShakeException))
forall a. IORef a -> IO a
readIORef IORef (Maybe (FilePath, ShakeException))
except
            let raiseError :: ShakeException -> IO ()
raiseError ShakeException
err
                    | Bool -> Bool
not Bool
shakeStaunch = ShakeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO ShakeException
err
                    | Bool
otherwise = do
                        let named :: ShakeException -> FilePath
named = ShakeOptions -> FilePath -> FilePath
shakeAbbreviationsApply ShakeOptions
opts (FilePath -> FilePath)
-> (ShakeException -> FilePath) -> ShakeException -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeException -> FilePath
shakeExceptionTarget
                        IORef (Maybe (FilePath, ShakeException))
-> (Maybe (FilePath, ShakeException)
    -> (Maybe (FilePath, ShakeException), ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Maybe (FilePath, ShakeException))
except ((Maybe (FilePath, ShakeException)
  -> (Maybe (FilePath, ShakeException), ()))
 -> IO ())
-> (Maybe (FilePath, ShakeException)
    -> (Maybe (FilePath, ShakeException), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe (FilePath, ShakeException)
v -> ((FilePath, ShakeException) -> Maybe (FilePath, ShakeException)
forall a. a -> Maybe a
Just ((FilePath, ShakeException) -> Maybe (FilePath, ShakeException))
-> (FilePath, ShakeException) -> Maybe (FilePath, ShakeException)
forall a b. (a -> b) -> a -> b
$ (FilePath, ShakeException)
-> Maybe (FilePath, ShakeException) -> (FilePath, ShakeException)
forall a. a -> Maybe a -> a
fromMaybe (ShakeException -> FilePath
named ShakeException
err, ShakeException
err) Maybe (FilePath, ShakeException)
v, ())
                        -- no need to print exceptions here, they get printed when they are wrapped

            IORef [IO ()]
after <- [IO ()] -> IO (IORef [IO ()])
forall a. a -> IO (IORef a)
newIORef []
            IORef [(Key, Key)]
absent <- [(Key, Key)] -> IO (IORef [(Key, Key)])
forall a. a -> IO (IORef a)
newIORef []
            Step
step <- Database -> IO Step
incrementStep Database
database
            IO Progress
getProgress <- Cleanup
-> ShakeOptions
-> Database
-> Step
-> IO (Maybe FilePath)
-> IO (IO Progress)
usingProgress Cleanup
cleanup ShakeOptions
opts Database
database Step
step IO (Maybe FilePath)
getFailure
            FilePath -> FilePath -> IO ()
lintCurrentDirectory FilePath
curdir FilePath
"When running"

            FilePath -> IO ()
watch <- [FilePath] -> IO (FilePath -> IO ())
lintWatch [FilePath]
shakeLintWatch
            let ruleFinished :: Key -> Action ()
ruleFinished
                    | Maybe Lint -> Bool
forall a. Maybe a -> Bool
isJust Maybe Lint
shakeLint = \Key
k -> do
                        IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
lintCurrentDirectory FilePath
curdir (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Key -> FilePath
forall a. Show a => a -> FilePath
show Key
k
                        Action ()
lintTrackFinished
                        IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
watch (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Key -> FilePath
forall a. Show a => a -> FilePath
show Key
k
                    | Bool
otherwise = IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> (Key -> IO ()) -> Key -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
watch (FilePath -> IO ()) -> (Key -> FilePath) -> Key -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> FilePath
forall a. Show a => a -> FilePath
show

            FilePath -> IO ()
addTiming FilePath
"Running rules"
            IORef [Local]
locals <- [Local] -> IO (IORef [Local])
forall a. a -> IO (IORef a)
newIORef []
            Bool -> Int -> (Pool -> IO ()) -> IO ()
runPool (Int
shakeThreads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) Int
shakeThreads ((Pool -> IO ()) -> IO ()) -> (Pool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
                let global :: Global
global = ([FilePath] -> [Key] -> Action [Value])
-> Database
-> Pool
-> Cleanup
-> IO Seconds
-> HashMap TypeRep BuiltinRule
-> (Verbosity -> FilePath -> IO ())
-> ShakeOptions
-> (IO FilePath -> IO ())
-> (Key -> Action ())
-> IORef [IO ()]
-> IORef [(Key, Key)]
-> IO Progress
-> Map UserRuleVersioned
-> Maybe Shared
-> Maybe Cloud
-> Step
-> Bool
-> Global
Global [FilePath] -> [Key] -> Action [Value]
applyKeyValue Database
database Pool
pool Cleanup
cleanup IO Seconds
start HashMap TypeRep BuiltinRule
builtinRules Verbosity -> FilePath -> IO ()
output ShakeOptions
opts IO FilePath -> IO ()
diagnostic Key -> Action ()
ruleFinished IORef [IO ()]
after IORef [(Key, Key)]
absent IO Progress
getProgress Map UserRuleVersioned
userRules Maybe Shared
shared Maybe Cloud
cloud Step
step Bool
oneshot
                -- give each action a stack to start with!
                [(Stack, Action ())] -> ((Stack, Action ()) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Stack, Action ())]
actions [(Stack, Action ())]
-> [(Stack, Action ())] -> [(Stack, Action ())]
forall a. [a] -> [a] -> [a]
++ (Action () -> (Stack, Action ()))
-> [Action ()] -> [(Stack, Action ())]
forall a b. (a -> b) -> [a] -> [b]
map (Stack
emptyStack,) [Action ()]
actions2) (((Stack, Action ()) -> IO ()) -> IO ())
-> ((Stack, Action ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Stack
stack, Action ()
act) -> do
                    let local :: Local
local = Stack -> Verbosity -> Local
newLocal Stack
stack Verbosity
shakeVerbosity
                    PoolPriority -> Pool -> IO () -> IO ()
forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
PoolStart Pool
pool (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Global
-> Local -> Action Local -> Capture (Either SomeException Local)
forall a.
Global -> Local -> Action a -> Capture (Either SomeException a)
runAction Global
global Local
local (Action ()
act Action () -> Action Local -> Action Local
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Action Local
getLocal) Capture (Either SomeException Local)
-> Capture (Either SomeException Local)
forall a b. (a -> b) -> a -> b
$ \case
                        Left SomeException
e -> ShakeException -> IO ()
raiseError (ShakeException -> IO ()) -> IO ShakeException -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Global -> Stack -> SomeException -> IO ShakeException
shakeException Global
global Stack
stack SomeException
e
                        Right Local
local -> IORef [Local] -> ([Local] -> [Local]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef [Local]
locals (Local
localLocal -> [Local] -> [Local]
forall a. a -> [a] -> [a]
:)

            IO (Maybe (FilePath, ShakeException))
-> ((FilePath, ShakeException) -> IO ()) -> IO ()
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM (IORef (Maybe (FilePath, ShakeException))
-> IO (Maybe (FilePath, ShakeException))
forall a. IORef a -> IO a
readIORef IORef (Maybe (FilePath, ShakeException))
except) (ShakeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ShakeException -> IO ())
-> ((FilePath, ShakeException) -> ShakeException)
-> (FilePath, ShakeException)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, ShakeException) -> ShakeException
forall a b. (a, b) -> b
snd)
            Database -> IO ()
assertFinishedDatabase Database
database
            let putWhen :: Verbosity -> FilePath -> IO ()
putWhen Verbosity
lvl FilePath
msg = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
lvl) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
output Verbosity
lvl FilePath
msg

            [Local]
locals <- IORef [Local] -> IO [Local]
forall a. IORef a -> IO a
readIORef IORef [Local]
locals
            Seconds
end <- IO Seconds
start
            if [(Stack, Action ())] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Stack, Action ())]
actions Bool -> Bool -> Bool
&& [Action ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Action ()]
actions2 then
                Verbosity -> FilePath -> IO ()
putWhen Verbosity
Info FilePath
"Warning: No want/action statements, nothing to do"
             else
                Step -> [Local] -> Seconds -> Database -> IO ()
recordRoot Step
step [Local]
locals Seconds
end Database
database

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Lint -> Bool
forall a. Maybe a -> Bool
isJust Maybe Lint
shakeLint) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                FilePath -> IO ()
addTiming FilePath
"Lint checking"
                FilePath -> FilePath -> IO ()
lintCurrentDirectory FilePath
curdir FilePath
"After completion"
                (IO FilePath -> IO ())
-> Database
-> (Key -> Value -> IO (Maybe FilePath))
-> [(Key, Key)]
-> IO ()
checkValid IO FilePath -> IO ()
diagnostic Database
database (HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe FilePath)
runLint HashMap TypeRep BuiltinRule
builtinRules) ([(Key, Key)] -> IO ()) -> IO [(Key, Key)] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef [(Key, Key)] -> IO [(Key, Key)]
forall a. IORef a -> IO a
readIORef IORef [(Key, Key)]
absent
                Verbosity -> FilePath -> IO ()
putWhen Verbosity
Verbose FilePath
"Lint checking succeeded"
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath]
shakeReport [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                FilePath -> IO ()
addTiming FilePath
"Profile report"
                [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
shakeReport ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
                    Verbosity -> FilePath -> IO ()
putWhen Verbosity
Info (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing report to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                    FilePath -> Database -> IO ()
writeProfile FilePath
file Database
database
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath]
shakeLiveFiles [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                FilePath -> IO ()
addTiming FilePath
"Listing live"
                IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"Listing live keys"
                [FilePath]
xs <- Database -> IO [FilePath]
liveFiles Database
database
                [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
shakeLiveFiles ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
                    Verbosity -> FilePath -> IO ()
putWhen Verbosity
Info (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing live list to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                    (if FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-" then FilePath -> IO ()
putStr else FilePath -> FilePath -> IO ()
writeFile FilePath
file) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
xs

            [IO ()]
res <- IORef [IO ()] -> IO [IO ()]
forall a. IORef a -> IO a
readIORef IORef [IO ()]
after
            FilePath -> IO ()
addTiming FilePath
"Cleanup"
            [IO ()] -> IO [IO ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [IO ()]
res

        IO (Maybe [FilePath]) -> ([FilePath] -> IO ()) -> IO ()
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM (IORef (Maybe [FilePath]) -> IO (Maybe [FilePath])
forall a. IORef a -> IO a
readIORef IORef (Maybe [FilePath])
timingsToShow) (([FilePath] -> IO ()) -> IO ()) -> ([FilePath] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath -> IO ()
putStr (FilePath -> IO ())
-> ([FilePath] -> FilePath) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines
        [IO ()] -> IO [IO ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [IO ()]
res


-- | Run a set of IO actions, treated as \"after\" actions, typically returned from
--   'Development.Shake.Database.shakeRunDatabase'. The actions will be run with diagnostics
--   etc as specified in the 'ShakeOptions'.
shakeRunAfter :: ShakeOptions -> [IO ()] -> IO ()
shakeRunAfter :: ShakeOptions -> [IO ()] -> IO ()
shakeRunAfter ShakeOptions
_ [] = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
shakeRunAfter ShakeOptions
opts [IO ()]
after = ShakeOptions
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO ())
-> IO ()
forall a.
ShakeOptions
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO a)
-> IO a
withInit ShakeOptions
opts ((ShakeOptions
  -> (IO FilePath -> IO ())
  -> (Verbosity -> FilePath -> IO ())
  -> IO ())
 -> IO ())
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \ShakeOptions{Bool
Int
FilePath
[FilePath]
[(FilePath, FilePath)]
[(Rebuild, FilePath)]
[CmdOption]
Maybe Seconds
Maybe FilePath
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
FilePath -> FilePath -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> FilePath -> IO ()
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: Verbosity -> FilePath -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [FilePath]
shakeShare :: Maybe FilePath
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [FilePath]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(FilePath, FilePath)]
shakeRebuild :: [(Rebuild, FilePath)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [FilePath]
shakeLintIgnore :: [FilePath]
shakeLintInside :: [FilePath]
shakeLint :: Maybe Lint
shakeReport :: [FilePath]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: FilePath
shakeThreads :: Int
shakeFiles :: FilePath
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> FilePath -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [FilePath]
shakeShare :: ShakeOptions -> Maybe FilePath
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [FilePath]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(FilePath, FilePath)]
shakeRebuild :: ShakeOptions -> [(Rebuild, FilePath)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [FilePath]
shakeLintIgnore :: ShakeOptions -> [FilePath]
shakeLintInside :: ShakeOptions -> [FilePath]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [FilePath]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> FilePath
..} IO FilePath -> IO ()
diagnostic Verbosity -> FilePath -> IO ()
_ -> do
    let n :: FilePath
n = Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ [IO ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IO ()]
after
    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Running " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" after actions"
    (Seconds
time, ()
_) <- IO () -> IO (Seconds, ())
forall (m :: * -> *) a. MonadIO m => m a -> m (Seconds, a)
duration (IO () -> IO (Seconds, ())) -> IO () -> IO (Seconds, ())
forall a b. (a -> b) -> a -> b
$ [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ [IO ()] -> [IO ()]
forall a. [a] -> [a]
reverse [IO ()]
after
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
shakeTimings Bool -> Bool -> Bool
&& Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Info) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"(+ running " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" after actions in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Seconds -> FilePath
showDuration Seconds
time FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"


withInit :: ShakeOptions -> (ShakeOptions -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a) -> IO a
withInit :: ShakeOptions
-> (ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Verbosity -> FilePath -> IO ())
    -> IO a)
-> IO a
withInit ShakeOptions
opts ShakeOptions
-> (IO FilePath -> IO ())
-> (Verbosity -> FilePath -> IO ())
-> IO a
act =
    (Cleanup -> IO a) -> IO a
forall a. (Cleanup -> IO a) -> IO a
withCleanup ((Cleanup -> IO a) -> IO a) -> (Cleanup -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Cleanup
cleanup -> do
        opts :: ShakeOptions
opts@ShakeOptions{Bool
Int
FilePath
[FilePath]
[(FilePath, FilePath)]
[(Rebuild, FilePath)]
[CmdOption]
Maybe Seconds
Maybe FilePath
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
FilePath -> FilePath -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> FilePath -> IO ()
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: Verbosity -> FilePath -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [FilePath]
shakeShare :: Maybe FilePath
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [FilePath]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(FilePath, FilePath)]
shakeRebuild :: [(Rebuild, FilePath)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [FilePath]
shakeLintIgnore :: [FilePath]
shakeLintInside :: [FilePath]
shakeLint :: Maybe Lint
shakeReport :: [FilePath]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: FilePath
shakeThreads :: Int
shakeFiles :: FilePath
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> FilePath -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [FilePath]
shakeShare :: ShakeOptions -> Maybe FilePath
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [FilePath]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(FilePath, FilePath)]
shakeRebuild :: ShakeOptions -> [(Rebuild, FilePath)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [FilePath]
shakeLintIgnore :: ShakeOptions -> [FilePath]
shakeLintInside :: ShakeOptions -> [FilePath]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [FilePath]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> FilePath
..} <- Cleanup -> ShakeOptions -> IO ShakeOptions
usingShakeOptions Cleanup
cleanup ShakeOptions
opts
        (IO FilePath -> IO ()
diagnostic, Verbosity -> FilePath -> IO ()
output) <- ShakeOptions
-> Lock -> (IO FilePath -> IO (), Verbosity -> FilePath -> IO ())
outputFunctions ShakeOptions
opts (Lock -> (IO FilePath -> IO (), Verbosity -> FilePath -> IO ()))
-> IO Lock
-> IO (IO FilePath -> IO (), Verbosity -> FilePath -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Lock
newLock
        ShakeOptions
-> (IO FilePath -> IO ())
-> (Verbosity -> FilePath -> IO ())
-> IO a
act ShakeOptions
opts IO FilePath -> IO ()
diagnostic Verbosity -> FilePath -> IO ()
output


usingShakeOptions :: Cleanup -> ShakeOptions -> IO ShakeOptions
usingShakeOptions :: Cleanup -> ShakeOptions -> IO ShakeOptions
usingShakeOptions Cleanup
cleanup ShakeOptions
opts = do
    opts :: ShakeOptions
opts@ShakeOptions{Bool
Int
FilePath
[FilePath]
[(FilePath, FilePath)]
[(Rebuild, FilePath)]
[CmdOption]
Maybe Seconds
Maybe FilePath
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
FilePath -> FilePath -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> FilePath -> IO ()
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: Verbosity -> FilePath -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [FilePath]
shakeShare :: Maybe FilePath
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [FilePath]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(FilePath, FilePath)]
shakeRebuild :: [(Rebuild, FilePath)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [FilePath]
shakeLintIgnore :: [FilePath]
shakeLintInside :: [FilePath]
shakeLint :: Maybe Lint
shakeReport :: [FilePath]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: FilePath
shakeThreads :: Int
shakeFiles :: FilePath
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> FilePath -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [FilePath]
shakeShare :: ShakeOptions -> Maybe FilePath
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [FilePath]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(FilePath, FilePath)]
shakeRebuild :: ShakeOptions -> [(Rebuild, FilePath)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [FilePath]
shakeLintIgnore :: ShakeOptions -> [FilePath]
shakeLintInside :: ShakeOptions -> [FilePath]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [FilePath]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> FilePath
..} <- if ShakeOptions -> Int
shakeThreads ShakeOptions
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then ShakeOptions -> IO ShakeOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeOptions
opts else do Int
p <- IO Int
getProcessorCount; ShakeOptions -> IO ShakeOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeOptions
opts{shakeThreads :: Int
shakeThreads=Int
p}
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shakeLineBuffering (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Cleanup -> IO ()
usingLineBuffering Cleanup
cleanup
    Cleanup -> Int -> IO ()
usingNumCapabilities Cleanup
cleanup Int
shakeThreads
    ShakeOptions -> IO ShakeOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeOptions
opts

outputFunctions :: ShakeOptions -> Lock -> (IO String -> IO (), Verbosity -> String -> IO ())
outputFunctions :: ShakeOptions
-> Lock -> (IO FilePath -> IO (), Verbosity -> FilePath -> IO ())
outputFunctions opts :: ShakeOptions
opts@ShakeOptions{Bool
Int
FilePath
[FilePath]
[(FilePath, FilePath)]
[(Rebuild, FilePath)]
[CmdOption]
Maybe Seconds
Maybe FilePath
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
FilePath -> FilePath -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> FilePath -> IO ()
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: Verbosity -> FilePath -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [FilePath]
shakeShare :: Maybe FilePath
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [FilePath]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(FilePath, FilePath)]
shakeRebuild :: [(Rebuild, FilePath)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [FilePath]
shakeLintIgnore :: [FilePath]
shakeLintInside :: [FilePath]
shakeLint :: Maybe Lint
shakeReport :: [FilePath]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: FilePath
shakeThreads :: Int
shakeFiles :: FilePath
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> FilePath -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [FilePath]
shakeShare :: ShakeOptions -> Maybe FilePath
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [FilePath]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(FilePath, FilePath)]
shakeRebuild :: ShakeOptions -> [(Rebuild, FilePath)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [FilePath]
shakeLintIgnore :: ShakeOptions -> [FilePath]
shakeLintInside :: ShakeOptions -> [FilePath]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [FilePath]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> FilePath
..} Lock
outputLock = (IO FilePath -> IO ()
diagnostic, Verbosity -> FilePath -> IO ()
output)
    where
        outputLocked :: Verbosity -> FilePath -> IO ()
outputLocked Verbosity
v FilePath
msg = Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLock Lock
outputLock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
shakeOutput Verbosity
v FilePath
msg

        diagnostic :: IO FilePath -> IO ()
diagnostic | Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Diagnostic = IO () -> IO FilePath -> IO ()
forall a b. a -> b -> a
const (IO () -> IO FilePath -> IO ()) -> IO () -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                   | Bool
otherwise = \IO FilePath
act -> do FilePath
v <- IO FilePath
act; Verbosity -> FilePath -> IO ()
outputLocked Verbosity
Diagnostic (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"% " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
v
        output :: Verbosity -> FilePath -> IO ()
output Verbosity
v = Verbosity -> FilePath -> IO ()
outputLocked Verbosity
v (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeOptions -> FilePath -> FilePath
shakeAbbreviationsApply ShakeOptions
opts


usingProgress :: Cleanup -> ShakeOptions -> Database -> Step -> IO (Maybe String) -> IO (IO Progress)
usingProgress :: Cleanup
-> ShakeOptions
-> Database
-> Step
-> IO (Maybe FilePath)
-> IO (IO Progress)
usingProgress Cleanup
cleanup ShakeOptions{Bool
Int
FilePath
[FilePath]
[(FilePath, FilePath)]
[(Rebuild, FilePath)]
[CmdOption]
Maybe Seconds
Maybe FilePath
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
FilePath -> FilePath -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> FilePath -> IO ()
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: Verbosity -> FilePath -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [FilePath]
shakeShare :: Maybe FilePath
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [FilePath]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(FilePath, FilePath)]
shakeRebuild :: [(Rebuild, FilePath)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [FilePath]
shakeLintIgnore :: [FilePath]
shakeLintInside :: [FilePath]
shakeLint :: Maybe Lint
shakeReport :: [FilePath]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: FilePath
shakeThreads :: Int
shakeFiles :: FilePath
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> FilePath -> FilePath -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> FilePath -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [FilePath]
shakeShare :: ShakeOptions -> Maybe FilePath
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [FilePath]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(FilePath, FilePath)]
shakeRebuild :: ShakeOptions -> [(Rebuild, FilePath)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [FilePath]
shakeLintIgnore :: ShakeOptions -> [FilePath]
shakeLintInside :: ShakeOptions -> [FilePath]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [FilePath]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> FilePath
..} Database
database Step
step IO (Maybe FilePath)
getFailure = do
    let getProgress :: IO Progress
getProgress = do
            Maybe FilePath
failure <- IO (Maybe FilePath)
getFailure
            Progress
stats <- Database -> Step -> IO Progress
progress Database
database Step
step
            Progress -> IO Progress
forall (f :: * -> *) a. Applicative f => a -> f a
pure Progress
stats{isFailure :: Maybe FilePath
isFailure=Maybe FilePath
failure}
    Cleanup -> IO () -> IO ()
allocateThread Cleanup
cleanup (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Progress -> IO ()
shakeProgress IO Progress
getProgress
    IO Progress -> IO (IO Progress)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO Progress
getProgress

checkShakeExtra :: Map.HashMap TypeRep Dynamic -> IO ()
checkShakeExtra :: HashMap TypeRep Dynamic -> IO ()
checkShakeExtra HashMap TypeRep Dynamic
mp = do
    let bad :: [(TypeRep, TypeRep)]
bad = [(TypeRep
k,TypeRep
t) | (TypeRep
k,Dynamic
v) <- HashMap TypeRep Dynamic -> [(TypeRep, Dynamic)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap TypeRep Dynamic
mp, let t :: TypeRep
t = Dynamic -> TypeRep
dynTypeRep Dynamic
v, TypeRep
t TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeRep
k]
    case [(TypeRep, TypeRep)]
bad of
        (TypeRep
k,TypeRep
t):[(TypeRep, TypeRep)]
xs -> SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [(FilePath, Maybe FilePath)] -> FilePath -> SomeException
errorStructured FilePath
"Invalid Map in shakeExtra"
            [(FilePath
"Key",FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ TypeRep -> FilePath
forall a. Show a => a -> FilePath
show TypeRep
k),(FilePath
"Value type",FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ TypeRep -> FilePath
forall a. Show a => a -> FilePath
show TypeRep
t)]
            (if [(TypeRep, TypeRep)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TypeRep, TypeRep)]
xs then FilePath
"" else FilePath
"Plus " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([(TypeRep, TypeRep)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TypeRep, TypeRep)]
xs) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" other keys")
        [(TypeRep, TypeRep)]
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


runLint :: Map.HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe String)
runLint :: HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe FilePath)
runLint HashMap TypeRep BuiltinRule
mp Key
k Value
v = case TypeRep -> HashMap TypeRep BuiltinRule -> Maybe BuiltinRule
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Key -> TypeRep
typeKey Key
k) HashMap TypeRep BuiltinRule
mp of
    Maybe BuiltinRule
Nothing -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    Just BuiltinRule{FilePath
BinaryOp Key
Ver
BuiltinRun Key Value
BuiltinIdentity Key Value
Key -> Value -> IO (Maybe FilePath)
builtinLocation :: BuiltinRule -> FilePath
builtinVersion :: BuiltinRule -> Ver
builtinKey :: BuiltinRule -> BinaryOp Key
builtinRun :: BuiltinRule -> BuiltinRun Key Value
builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
builtinLint :: BuiltinRule -> Key -> Value -> IO (Maybe FilePath)
builtinLocation :: FilePath
builtinVersion :: Ver
builtinKey :: BinaryOp Key
builtinRun :: BuiltinRun Key Value
builtinIdentity :: BuiltinIdentity Key Value
builtinLint :: Key -> Value -> IO (Maybe FilePath)
..} -> Key -> Value -> IO (Maybe FilePath)
builtinLint Key
k Value
v


assertFinishedDatabase :: Database -> IO ()
assertFinishedDatabase :: Database -> IO ()
assertFinishedDatabase Database
database = do
    -- if you have anyone Waiting, and are not exiting with an error, then must have a complex recursion (see #400)
    [(Key, Status)]
status <- Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
database
    let bad :: [Key]
bad = [Key
key | (Key
key, Running{}) <- [(Key, Status)]
status]
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Key]
bad [Key] -> [Key] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> SomeException
errorComplexRecursion ((Key -> FilePath) -> [Key] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Key -> FilePath
forall a. Show a => a -> FilePath
show [Key]
bad)


liveFilesState :: RunState -> IO [FilePath]
liveFilesState :: RunState -> IO [FilePath]
liveFilesState RunState{FilePath
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
actions :: [(Stack, Action ())]
cloud :: Maybe Cloud
shared :: Maybe Shared
curdir :: FilePath
database :: Database
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
opts :: ShakeOptions
actions :: RunState -> [(Stack, Action ())]
cloud :: RunState -> Maybe Cloud
shared :: RunState -> Maybe Shared
curdir :: RunState -> FilePath
database :: RunState -> Database
userRules :: RunState -> Map UserRuleVersioned
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
opts :: RunState -> ShakeOptions
..} = Database -> IO [FilePath]
liveFiles Database
database

profileState :: RunState -> FilePath -> IO ()
profileState :: RunState -> FilePath -> IO ()
profileState RunState{FilePath
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
actions :: [(Stack, Action ())]
cloud :: Maybe Cloud
shared :: Maybe Shared
curdir :: FilePath
database :: Database
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
opts :: ShakeOptions
actions :: RunState -> [(Stack, Action ())]
cloud :: RunState -> Maybe Cloud
shared :: RunState -> Maybe Shared
curdir :: RunState -> FilePath
database :: RunState -> Database
userRules :: RunState -> Map UserRuleVersioned
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
opts :: RunState -> ShakeOptions
..} FilePath
file = FilePath -> Database -> IO ()
writeProfile FilePath
file Database
database

liveFiles :: Database -> IO [FilePath]
liveFiles :: Database -> IO [FilePath]
liveFiles Database
database = do
    [(Key, Status)]
status <- Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
database
    let specialIsFileKey :: TypeRep -> Bool
specialIsFileKey TypeRep
t = TyCon -> FilePath
forall a. Show a => a -> FilePath
show ((TyCon, [TypeRep]) -> TyCon
forall a b. (a, b) -> a
fst ((TyCon, [TypeRep]) -> TyCon) -> (TyCon, [TypeRep]) -> TyCon
forall a b. (a -> b) -> a -> b
$ TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
t) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"FileQ"
    [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Key -> FilePath
forall a. Show a => a -> FilePath
show Key
k | (Key
k, Ready{}) <- [(Key, Status)]
status, TypeRep -> Bool
specialIsFileKey (TypeRep -> Bool) -> TypeRep -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> TypeRep
typeKey Key
k]

errorsState :: RunState -> IO [(String, SomeException)]
errorsState :: RunState -> IO [(FilePath, SomeException)]
errorsState RunState{FilePath
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
actions :: [(Stack, Action ())]
cloud :: Maybe Cloud
shared :: Maybe Shared
curdir :: FilePath
database :: Database
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
opts :: ShakeOptions
actions :: RunState -> [(Stack, Action ())]
cloud :: RunState -> Maybe Cloud
shared :: RunState -> Maybe Shared
curdir :: RunState -> FilePath
database :: RunState -> Database
userRules :: RunState -> Map UserRuleVersioned
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
opts :: RunState -> ShakeOptions
..} = do
    [(Key, Status)]
status <- Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
database
    [(FilePath, SomeException)] -> IO [(FilePath, SomeException)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Key -> FilePath
forall a. Show a => a -> FilePath
show Key
k, SomeException
e) | (Key
k, Failed SomeException
e OneShot (Maybe (Result (OneShot BS_Store)))
_) <- [(Key, Status)]
status]


checkValid :: (IO String -> IO ()) -> Database -> (Key -> Value -> IO (Maybe String)) -> [(Key, Key)] -> IO ()
checkValid :: (IO FilePath -> IO ())
-> Database
-> (Key -> Value -> IO (Maybe FilePath))
-> [(Key, Key)]
-> IO ()
checkValid IO FilePath -> IO ()
diagnostic Database
db Key -> Value -> IO (Maybe FilePath)
check [(Key, Key)]
absent = do
    [(Key, Status)]
status <- Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
db
    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"Starting validity/lint checking"

    -- TEST 1: Have values changed since being depended on
    -- Do not use a forM here as you use too much stack space
    [(Key, (Value, OneShot BS_Store), FilePath)]
bad <- (\[(Key, (Value, OneShot BS_Store), FilePath)]
-> (Key, Status) -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
f -> ([(Key, (Value, OneShot BS_Store), FilePath)]
 -> (Key, Status)
 -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
-> [(Key, (Value, OneShot BS_Store), FilePath)]
-> [(Key, Status)]
-> IO [(Key, (Value, OneShot BS_Store), FilePath)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [(Key, (Value, OneShot BS_Store), FilePath)]
-> (Key, Status) -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
f [] [(Key, Status)]
status) (([(Key, (Value, OneShot BS_Store), FilePath)]
  -> (Key, Status)
  -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
 -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
-> ([(Key, (Value, OneShot BS_Store), FilePath)]
    -> (Key, Status)
    -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
-> IO [(Key, (Value, OneShot BS_Store), FilePath)]
forall a b. (a -> b) -> a -> b
$ \[(Key, (Value, OneShot BS_Store), FilePath)]
seen (Key, Status)
v -> case (Key, Status)
v of
        (Key
key, Ready Result{Float
[Depends]
[Trace]
(Value, OneShot BS_Store)
Step
traces :: forall a. Result a -> [Trace]
execution :: forall a. Result a -> Float
depends :: forall a. Result a -> [Depends]
changed :: forall a. Result a -> Step
built :: forall a. Result a -> Step
result :: forall a. Result a -> a
traces :: [Trace]
execution :: Float
depends :: [Depends]
changed :: Step
built :: Step
result :: (Value, OneShot BS_Store)
..}) -> do
            Maybe FilePath
good <- Key -> Value -> IO (Maybe FilePath)
check Key
key (Value -> IO (Maybe FilePath)) -> Value -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (Value, OneShot BS_Store) -> Value
forall a b. (a, b) -> a
fst (Value, OneShot BS_Store)
result
            IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Checking if " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Key -> FilePath
forall a. Show a => a -> FilePath
show Key
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Value, OneShot BS_Store) -> FilePath
forall a. Show a => a -> FilePath
show (Value, OneShot BS_Store)
result FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
good then FilePath
"passed" else FilePath
"FAILED"
            [(Key, (Value, OneShot BS_Store), FilePath)]
-> IO [(Key, (Value, OneShot BS_Store), FilePath)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Key, (Value, OneShot BS_Store), FilePath)]
 -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
-> [(Key, (Value, OneShot BS_Store), FilePath)]
-> IO [(Key, (Value, OneShot BS_Store), FilePath)]
forall a b. (a -> b) -> a -> b
$ [(Key
key, (Value, OneShot BS_Store)
result, FilePath
now) | Just FilePath
now <- [Maybe FilePath
good]] [(Key, (Value, OneShot BS_Store), FilePath)]
-> [(Key, (Value, OneShot BS_Store), FilePath)]
-> [(Key, (Value, OneShot BS_Store), FilePath)]
forall a. [a] -> [a] -> [a]
++ [(Key, (Value, OneShot BS_Store), FilePath)]
seen
        (Key, Status)
_ -> [(Key, (Value, OneShot BS_Store), FilePath)]
-> IO [(Key, (Value, OneShot BS_Store), FilePath)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Key, (Value, OneShot BS_Store), FilePath)]
seen
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Key, (Value, OneShot BS_Store), FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Key, (Value, OneShot BS_Store), FilePath)]
bad) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let n :: Int
n = [(Key, (Value, OneShot BS_Store), FilePath)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Key, (Value, OneShot BS_Store), FilePath)]
bad
        SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [(FilePath, Maybe FilePath)] -> FilePath -> SomeException
errorStructured
            (FilePath
"Lint checking error - " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then FilePath
"value has" else Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" values have")  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" changed since being depended upon")
            ([(FilePath, Maybe FilePath)]
-> [[(FilePath, Maybe FilePath)]] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [[a]] -> [a]
intercalate [(FilePath
"",FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"")] [ [(FilePath
"Key", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Key -> FilePath
forall a. Show a => a -> FilePath
show Key
key),(FilePath
"Old", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (Value, OneShot BS_Store) -> FilePath
forall a. Show a => a -> FilePath
show (Value, OneShot BS_Store)
result),(FilePath
"New", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
now)]
                                        | (Key
key, (Value, OneShot BS_Store)
result, FilePath
now) <- [(Key, (Value, OneShot BS_Store), FilePath)]
bad])
            FilePath
""

    -- TEST 2: Is anything from lintTrackWrite which promised not to exist actually been created
    Key -> Maybe Id
exists <- Database -> IO (Key -> Maybe Id)
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> IO (k -> Maybe Id)
getIdFromKey Database
db
    [(Key, Key)]
bad <- [(Key, Key)] -> IO [(Key, Key)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Key
parent,Key
key) | (Key
parent, Key
key) <- HashSet (Key, Key) -> [(Key, Key)]
forall a. HashSet a -> [a]
Set.toList (HashSet (Key, Key) -> [(Key, Key)])
-> HashSet (Key, Key) -> [(Key, Key)]
forall a b. (a -> b) -> a -> b
$ [(Key, Key)] -> HashSet (Key, Key)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [(Key, Key)]
absent, Maybe Id -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Id -> Bool) -> Maybe Id -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> Maybe Id
exists Key
key]
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Key, Key)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Key, Key)]
bad) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let n :: Int
n = [(Key, Key)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Key, Key)]
bad
        SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [(FilePath, Maybe FilePath)] -> FilePath -> SomeException
errorStructured
            (FilePath
"Lint checking error - " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then FilePath
"value" else Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" values") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" did not have " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then FilePath
"its" else FilePath
"their") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" creation tracked")
            ([(FilePath, Maybe FilePath)]
-> [[(FilePath, Maybe FilePath)]] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [[a]] -> [a]
intercalate [(FilePath
"",FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"")] [ [(FilePath
"Rule", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Key -> FilePath
forall a. Show a => a -> FilePath
show Key
parent), (FilePath
"Created", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Key -> FilePath
forall a. Show a => a -> FilePath
show Key
key)] | (Key
parent,Key
key) <- [(Key, Key)]
bad])
            FilePath
""

    IO FilePath -> IO ()
diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"Validity/lint check passed"


---------------------------------------------------------------------
-- STORAGE

usingDatabase :: Cleanup -> ShakeOptions -> (IO String -> IO ()) -> Map.HashMap TypeRep BuiltinRule -> IO Database
usingDatabase :: Cleanup
-> ShakeOptions
-> (IO FilePath -> IO ())
-> HashMap TypeRep BuiltinRule
-> IO Database
usingDatabase Cleanup
cleanup ShakeOptions
opts IO FilePath -> IO ()
diagnostic HashMap TypeRep BuiltinRule
owitness = do
    let step :: (TypeRep, (Ver, BinaryOp Key))
step = (Proxy StepKey -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy StepKey
forall k (t :: k). Proxy t
Proxy :: Proxy StepKey), (Int -> Ver
Ver Int
0, (Key -> Builder) -> (OneShot BS_Store -> Key) -> BinaryOp Key
forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
BinaryOp (Builder -> Key -> Builder
forall a b. a -> b -> a
const Builder
forall a. Monoid a => a
mempty) (Key -> OneShot BS_Store -> Key
forall a b. a -> b -> a
const Key
stepKey)))
    let root :: (TypeRep, (Ver, BinaryOp Key))
root = (Proxy Root -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy Root
forall k (t :: k). Proxy t
Proxy :: Proxy Root), (Int -> Ver
Ver Int
0, (Key -> Builder) -> (OneShot BS_Store -> Key) -> BinaryOp Key
forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
BinaryOp (Builder -> Key -> Builder
forall a b. a -> b -> a
const Builder
forall a. Monoid a => a
mempty) (Key -> OneShot BS_Store -> Key
forall a b. a -> b -> a
const Key
rootKey)))
    HashMap QTypeRep (Ver, BinaryOp (Key, Status))
witness<- HashMap QTypeRep (Ver, BinaryOp (Key, Status))
-> IO (HashMap QTypeRep (Ver, BinaryOp (Key, Status)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap QTypeRep (Ver, BinaryOp (Key, Status))
 -> IO (HashMap QTypeRep (Ver, BinaryOp (Key, Status))))
-> HashMap QTypeRep (Ver, BinaryOp (Key, Status))
-> IO (HashMap QTypeRep (Ver, BinaryOp (Key, Status)))
forall a b. (a -> b) -> a -> b
$ [(QTypeRep, (Ver, BinaryOp (Key, Status)))]
-> HashMap QTypeRep (Ver, BinaryOp (Key, Status))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList
        [ (TypeRep -> QTypeRep
QTypeRep TypeRep
t, (Ver
version, ((Key, Status) -> Builder)
-> (OneShot BS_Store -> (Key, Status)) -> BinaryOp (Key, Status)
forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
BinaryOp ((Key -> Builder) -> (Key, Status) -> Builder
putDatabase Key -> Builder
putOp) ((OneShot BS_Store -> Key) -> OneShot BS_Store -> (Key, Status)
getDatabase OneShot BS_Store -> Key
getOp)))
        | (TypeRep
t,(Ver
version, BinaryOp{OneShot BS_Store -> Key
Key -> Builder
getOp :: forall v. BinaryOp v -> OneShot BS_Store -> v
putOp :: forall v. BinaryOp v -> v -> Builder
getOp :: OneShot BS_Store -> Key
putOp :: Key -> Builder
..})) <- (TypeRep, (Ver, BinaryOp Key))
step (TypeRep, (Ver, BinaryOp Key))
-> [(TypeRep, (Ver, BinaryOp Key))]
-> [(TypeRep, (Ver, BinaryOp Key))]
forall a. a -> [a] -> [a]
: (TypeRep, (Ver, BinaryOp Key))
root (TypeRep, (Ver, BinaryOp Key))
-> [(TypeRep, (Ver, BinaryOp Key))]
-> [(TypeRep, (Ver, BinaryOp Key))]
forall a. a -> [a] -> [a]
: HashMap TypeRep (Ver, BinaryOp Key)
-> [(TypeRep, (Ver, BinaryOp Key))]
forall k v. HashMap k v -> [(k, v)]
Map.toList ((BuiltinRule -> (Ver, BinaryOp Key))
-> HashMap TypeRep BuiltinRule
-> HashMap TypeRep (Ver, BinaryOp Key)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map (\BuiltinRule{FilePath
BinaryOp Key
Ver
BuiltinRun Key Value
BuiltinIdentity Key Value
Key -> Value -> IO (Maybe FilePath)
builtinLocation :: FilePath
builtinVersion :: Ver
builtinKey :: BinaryOp Key
builtinRun :: BuiltinRun Key Value
builtinIdentity :: BuiltinIdentity Key Value
builtinLint :: Key -> Value -> IO (Maybe FilePath)
builtinLocation :: BuiltinRule -> FilePath
builtinVersion :: BuiltinRule -> Ver
builtinKey :: BuiltinRule -> BinaryOp Key
builtinRun :: BuiltinRule -> BuiltinRun Key Value
builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
builtinLint :: BuiltinRule -> Key -> Value -> IO (Maybe FilePath)
..} -> (Ver
builtinVersion, BinaryOp Key
builtinKey)) HashMap TypeRep BuiltinRule
owitness)]
    (Ids (Key, Status)
status, QTypeRep -> Id -> (Key, Status) -> IO ()
journal) <- Cleanup
-> ShakeOptions
-> (IO FilePath -> IO ())
-> HashMap QTypeRep (Ver, BinaryOp (Key, Status))
-> IO (Ids (Key, Status), QTypeRep -> Id -> (Key, Status) -> IO ())
forall k v.
(Show k, Eq k, Hashable k, NFData k, Show v, NFData v) =>
Cleanup
-> ShakeOptions
-> (IO FilePath -> IO ())
-> HashMap k (Ver, BinaryOp v)
-> IO (Ids v, k -> Id -> v -> IO ())
usingStorage Cleanup
cleanup ShakeOptions
opts IO FilePath -> IO ()
diagnostic HashMap QTypeRep (Ver, BinaryOp (Key, Status))
witness
    Id -> Key -> Status -> IO ()
journal<- (Id -> Key -> Status -> IO ()) -> IO (Id -> Key -> Status -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Id -> Key -> Status -> IO ())
 -> IO (Id -> Key -> Status -> IO ()))
-> (Id -> Key -> Status -> IO ())
-> IO (Id -> Key -> Status -> IO ())
forall a b. (a -> b) -> a -> b
$ \Id
i Key
k Status
v -> QTypeRep -> Id -> (Key, Status) -> IO ()
journal (TypeRep -> QTypeRep
QTypeRep (TypeRep -> QTypeRep) -> TypeRep -> QTypeRep
forall a b. (a -> b) -> a -> b
$ Key -> TypeRep
typeKey Key
k) Id
i (Key
k, Status
v)
    Ids (Key, Status)
-> (Id -> Key -> Status -> IO ()) -> Status -> IO Database
forall k v.
(Eq k, Hashable k) =>
Ids (k, v) -> (Id -> k -> v -> IO ()) -> v -> IO (DatabasePoly k v)
createDatabase Ids (Key, Status)
status Id -> Key -> Status -> IO ()
journal Status
Missing


incrementStep :: Database -> IO Step
incrementStep :: Database -> IO Step
incrementStep Database
db = Database -> Locked Step -> IO Step
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
db (Locked Step -> IO Step) -> Locked Step -> IO Step
forall a b. (a -> b) -> a -> b
$ do
    Id
stepId <- Database -> Key -> Locked Id
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
db Key
stepKey
    Maybe (Key, Status)
v <- IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status)))
-> IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall a b. (a -> b) -> a -> b
$ Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
db Id
stepId
    Step
step <- IO Step -> Locked Step
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Step -> Locked Step) -> IO Step -> Locked Step
forall a b. (a -> b) -> a -> b
$ Step -> IO Step
forall a. a -> IO a
evaluate (Step -> IO Step) -> Step -> IO Step
forall a b. (a -> b) -> a -> b
$ case Maybe (Key, Status)
v of
        Just (Key
_, Loaded Result (OneShot BS_Store)
r) -> Step -> Step
incStep (Step -> Step) -> Step -> Step
forall a b. (a -> b) -> a -> b
$ Result (OneShot BS_Store) -> Step
fromStepResult Result (OneShot BS_Store)
r
        Maybe (Key, Status)
_ -> Word32 -> Step
Step Word32
1
    let stepRes :: Result (Value, OneShot BS_Store)
stepRes = Step -> Result (Value, OneShot BS_Store)
toStepResult Step
step
    Database -> Id -> Key -> Status -> Locked ()
forall k v. DatabasePoly k v -> Id -> k -> v -> Locked ()
setMem Database
db Id
stepId Key
stepKey (Status -> Locked ()) -> Status -> Locked ()
forall a b. (a -> b) -> a -> b
$ Result (Value, OneShot BS_Store) -> Status
Ready Result (Value, OneShot BS_Store)
stepRes
    IO () -> Locked ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Locked ()) -> IO () -> Locked ()
forall a b. (a -> b) -> a -> b
$ Database -> Id -> Key -> Status -> IO ()
forall k v. DatabasePoly k v -> Id -> k -> v -> IO ()
setDisk Database
db Id
stepId Key
stepKey (Status -> IO ()) -> Status -> IO ()
forall a b. (a -> b) -> a -> b
$ Result (OneShot BS_Store) -> Status
Loaded (Result (OneShot BS_Store) -> Status)
-> Result (OneShot BS_Store) -> Status
forall a b. (a -> b) -> a -> b
$ ((Value, OneShot BS_Store) -> OneShot BS_Store)
-> Result (Value, OneShot BS_Store) -> Result (OneShot BS_Store)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value, OneShot BS_Store) -> OneShot BS_Store
forall a b. (a, b) -> b
snd Result (Value, OneShot BS_Store)
stepRes
    Step -> Locked Step
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step
step

toStepResult :: Step -> Result (Value, BS_Store)
toStepResult :: Step -> Result (Value, OneShot BS_Store)
toStepResult Step
i = (Value, OneShot BS_Store)
-> Step
-> Step
-> [Depends]
-> Float
-> [Trace]
-> Result (Value, OneShot BS_Store)
forall a.
a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
Result (Step -> Value
forall a. (Typeable a, Show a, NFData a) => a -> Value
newValue Step
i, Builder -> OneShot BS_Store
runBuilder (Builder -> OneShot BS_Store) -> Builder -> OneShot BS_Store
forall a b. (a -> b) -> a -> b
$ Step -> Builder
forall a. BinaryEx a => a -> Builder
putEx Step
i) Step
i Step
i [] Float
0 []

fromStepResult :: Result BS_Store -> Step
fromStepResult :: Result (OneShot BS_Store) -> Step
fromStepResult = OneShot BS_Store -> Step
forall a. BinaryEx a => OneShot BS_Store -> a
getEx (OneShot BS_Store -> Step)
-> (Result (OneShot BS_Store) -> OneShot BS_Store)
-> Result (OneShot BS_Store)
-> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result (OneShot BS_Store) -> OneShot BS_Store
forall a. Result a -> a
result


recordRoot :: Step -> [Local] -> Seconds -> Database -> IO ()
recordRoot :: Step -> [Local] -> Seconds -> Database -> IO ()
recordRoot Step
step [Local]
locals (Seconds -> Float
doubleToFloat -> Float
end) Database
db = Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
db (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Id
rootId <- Database -> Key -> Locked Id
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
db Key
rootKey
    let local :: Local
local = Local -> [Local] -> Local
localMergeMutable (Stack -> Verbosity -> Local
newLocal Stack
emptyStack Verbosity
Info) [Local]
locals
    let rootRes :: Result (Value, OneShot BS_Store)
rootRes = Result :: forall a.
a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
Result
            {result :: (Value, OneShot BS_Store)
result = (() -> Value
forall a. (Typeable a, Show a, NFData a) => a -> Value
newValue (), OneShot BS_Store
BS.empty)
            ,changed :: Step
changed = Step
step
            ,built :: Step
built = Step
step
            ,depends :: [Depends]
depends = DependsList -> [Depends]
flattenDepends (DependsList -> [Depends]) -> DependsList -> [Depends]
forall a b. (a -> b) -> a -> b
$ Local -> DependsList
localDepends Local
local
            ,execution :: Float
execution = Float
0
            ,traces :: [Trace]
traces = Traces -> [Trace]
flattenTraces (Traces -> [Trace]) -> Traces -> [Trace]
forall a b. (a -> b) -> a -> b
$ Traces -> Trace -> Traces
addTrace (Local -> Traces
localTraces Local
local) (Trace -> Traces) -> Trace -> Traces
forall a b. (a -> b) -> a -> b
$ OneShot BS_Store -> Float -> Float -> Trace
Trace OneShot BS_Store
BS.empty Float
end Float
end}
    Database -> Id -> Key -> Status -> Locked ()
forall k v. DatabasePoly k v -> Id -> k -> v -> Locked ()
setMem Database
db Id
rootId Key
rootKey (Status -> Locked ()) -> Status -> Locked ()
forall a b. (a -> b) -> a -> b
$ Result (Value, OneShot BS_Store) -> Status
Ready Result (Value, OneShot BS_Store)
rootRes
    IO () -> Locked ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Locked ()) -> IO () -> Locked ()
forall a b. (a -> b) -> a -> b
$ Database -> Id -> Key -> Status -> IO ()
forall k v. DatabasePoly k v -> Id -> k -> v -> IO ()
setDisk Database
db Id
rootId Key
rootKey (Status -> IO ()) -> Status -> IO ()
forall a b. (a -> b) -> a -> b
$ Result (OneShot BS_Store) -> Status
Loaded (Result (OneShot BS_Store) -> Status)
-> Result (OneShot BS_Store) -> Status
forall a b. (a -> b) -> a -> b
$ ((Value, OneShot BS_Store) -> OneShot BS_Store)
-> Result (Value, OneShot BS_Store) -> Result (OneShot BS_Store)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value, OneShot BS_Store) -> OneShot BS_Store
forall a b. (a, b) -> b
snd Result (Value, OneShot BS_Store)
rootRes


loadSharedCloud :: DatabasePoly k v -> ShakeOptions -> Map.HashMap TypeRep BuiltinRule -> IO (Maybe Shared, Maybe Cloud)
loadSharedCloud :: DatabasePoly k v
-> ShakeOptions
-> HashMap TypeRep BuiltinRule
-> IO (Maybe Shared, Maybe Cloud)
loadSharedCloud DatabasePoly k v
var ShakeOptions
opts HashMap TypeRep BuiltinRule
owitness = do
    let mp :: HashMap FilePath BuiltinRule
mp = [(FilePath, BuiltinRule)] -> HashMap FilePath BuiltinRule
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(FilePath, BuiltinRule)] -> HashMap FilePath BuiltinRule)
-> [(FilePath, BuiltinRule)] -> HashMap FilePath BuiltinRule
forall a b. (a -> b) -> a -> b
$ ((TypeRep, BuiltinRule) -> (FilePath, BuiltinRule))
-> [(TypeRep, BuiltinRule)] -> [(FilePath, BuiltinRule)]
forall a b. (a -> b) -> [a] -> [b]
map ((TypeRep -> FilePath)
-> (TypeRep, BuiltinRule) -> (FilePath, BuiltinRule)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((TypeRep -> FilePath)
 -> (TypeRep, BuiltinRule) -> (FilePath, BuiltinRule))
-> (TypeRep -> FilePath)
-> (TypeRep, BuiltinRule)
-> (FilePath, BuiltinRule)
forall a b. (a -> b) -> a -> b
$ QTypeRep -> FilePath
forall a. Show a => a -> FilePath
show (QTypeRep -> FilePath)
-> (TypeRep -> QTypeRep) -> TypeRep -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> QTypeRep
QTypeRep) ([(TypeRep, BuiltinRule)] -> [(FilePath, BuiltinRule)])
-> [(TypeRep, BuiltinRule)] -> [(FilePath, BuiltinRule)]
forall a b. (a -> b) -> a -> b
$ HashMap TypeRep BuiltinRule -> [(TypeRep, BuiltinRule)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap TypeRep BuiltinRule
owitness
    let wit :: BinaryOp (FilePath, Key)
wit = (FilePath -> BinaryOp Key) -> BinaryOp (FilePath, Key)
forall a b. BinaryEx a => (a -> BinaryOp b) -> BinaryOp (a, b)
binaryOpMap ((FilePath -> BinaryOp Key) -> BinaryOp (FilePath, Key))
-> (FilePath -> BinaryOp Key) -> BinaryOp (FilePath, Key)
forall a b. (a -> b) -> a -> b
$ \FilePath
a -> BinaryOp Key
-> (BuiltinRule -> BinaryOp Key)
-> Maybe BuiltinRule
-> BinaryOp Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> BinaryOp Key
forall a. HasCallStack => FilePath -> a
error (FilePath -> BinaryOp Key) -> FilePath -> BinaryOp Key
forall a b. (a -> b) -> a -> b
$ FilePath
"loadSharedCloud, couldn't find map for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
a) BuiltinRule -> BinaryOp Key
builtinKey (Maybe BuiltinRule -> BinaryOp Key)
-> Maybe BuiltinRule -> BinaryOp Key
forall a b. (a -> b) -> a -> b
$ FilePath -> HashMap FilePath BuiltinRule -> Maybe BuiltinRule
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
a HashMap FilePath BuiltinRule
mp
    let wit2 :: BinaryOp Key
wit2 = (Key -> Builder) -> (OneShot BS_Store -> Key) -> BinaryOp Key
forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
BinaryOp (\Key
k -> BinaryOp (FilePath, Key) -> (FilePath, Key) -> Builder
forall v. BinaryOp v -> v -> Builder
putOp BinaryOp (FilePath, Key)
wit (QTypeRep -> FilePath
forall a. Show a => a -> FilePath
show (QTypeRep -> FilePath) -> QTypeRep -> FilePath
forall a b. (a -> b) -> a -> b
$ TypeRep -> QTypeRep
QTypeRep (TypeRep -> QTypeRep) -> TypeRep -> QTypeRep
forall a b. (a -> b) -> a -> b
$ Key -> TypeRep
typeKey Key
k, Key
k)) ((FilePath, Key) -> Key
forall a b. (a, b) -> b
snd ((FilePath, Key) -> Key)
-> (OneShot BS_Store -> (FilePath, Key)) -> OneShot BS_Store -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryOp (FilePath, Key) -> OneShot BS_Store -> (FilePath, Key)
forall v. BinaryOp v -> OneShot BS_Store -> v
getOp BinaryOp (FilePath, Key)
wit)
    let keyVers :: [(TypeRep, Ver)]
keyVers = [(TypeRep
k, BuiltinRule -> Ver
builtinVersion BuiltinRule
v) | (TypeRep
k,BuiltinRule
v) <- HashMap TypeRep BuiltinRule -> [(TypeRep, BuiltinRule)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap TypeRep BuiltinRule
owitness]
    let ver :: Ver
ver = FilePath -> Ver
makeVer (FilePath -> Ver) -> FilePath -> Ver
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> FilePath
shakeVersion ShakeOptions
opts

    Maybe Shared
shared <- case ShakeOptions -> Maybe FilePath
shakeShare ShakeOptions
opts of
        Maybe FilePath
Nothing -> Maybe Shared -> IO (Maybe Shared)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Shared
forall a. Maybe a
Nothing
        Just FilePath
x -> Shared -> Maybe Shared
forall a. a -> Maybe a
Just (Shared -> Maybe Shared) -> IO Shared -> IO (Maybe Shared)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> BinaryOp Key -> Ver -> FilePath -> IO Shared
newShared (ShakeOptions -> Bool
shakeSymlink ShakeOptions
opts) BinaryOp Key
wit2 Ver
ver FilePath
x
    Maybe Cloud
cloud <- case (Locked () -> IO ())
-> HashMap TypeRep (BinaryOp Key)
-> Ver
-> [(TypeRep, Ver)]
-> [FilePath]
-> Maybe (IO Cloud)
newCloud (DatabasePoly k v -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked DatabasePoly k v
var) ((BuiltinRule -> BinaryOp Key)
-> HashMap TypeRep BuiltinRule -> HashMap TypeRep (BinaryOp Key)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map BuiltinRule -> BinaryOp Key
builtinKey HashMap TypeRep BuiltinRule
owitness) Ver
ver [(TypeRep, Ver)]
keyVers ([FilePath] -> Maybe (IO Cloud)) -> [FilePath] -> Maybe (IO Cloud)
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> [FilePath]
shakeCloud ShakeOptions
opts of
        Maybe (IO Cloud)
_ | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> [FilePath]
shakeCloud ShakeOptions
opts -> Maybe Cloud -> IO (Maybe Cloud)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Cloud
forall a. Maybe a
Nothing
        Maybe (IO Cloud)
Nothing -> FilePath -> IO (Maybe Cloud)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"shakeCloud set but Shake not compiled for cloud operation"
        Just IO Cloud
res -> Cloud -> Maybe Cloud
forall a. a -> Maybe a
Just (Cloud -> Maybe Cloud) -> IO Cloud -> IO (Maybe Cloud)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Cloud
res
    (Maybe Shared, Maybe Cloud) -> IO (Maybe Shared, Maybe Cloud)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Shared
shared, Maybe Cloud
cloud)


putDatabase :: (Key -> Builder) -> ((Key, Status) -> Builder)
putDatabase :: (Key -> Builder) -> (Key, Status) -> Builder
putDatabase Key -> Builder
putKey (Key
key, Loaded (Result OneShot BS_Store
x1 Step
x2 Step
x3 [Depends]
x4 Float
x5 [Trace]
x6)) =
    Builder -> Builder
putExN (Key -> Builder
putKey Key
key) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
putExN (OneShot BS_Store -> Builder
forall a. BinaryEx a => a -> Builder
putEx OneShot BS_Store
x1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Step -> Builder
forall a. BinaryEx a => a -> Builder
putEx Step
x2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Step -> Builder
forall a. BinaryEx a => a -> Builder
putEx Step
x3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
forall a. BinaryEx a => a -> Builder
putEx Float
x5 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
putExN ([Depends] -> Builder
forall a. BinaryEx a => a -> Builder
putEx [Depends]
x4) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Trace] -> Builder
forall a. BinaryEx a => a -> Builder
putEx [Trace]
x6
putDatabase Key -> Builder
_ (Key
_, Status
x) = SomeException -> Builder
forall a. SomeException -> a
throwImpure (SomeException -> Builder) -> SomeException -> Builder
forall a b. (a -> b) -> a -> b
$ HasCallStack => FilePath -> SomeException
FilePath -> SomeException
errorInternal (FilePath -> SomeException) -> FilePath -> SomeException
forall a b. (a -> b) -> a -> b
$ FilePath
"putWith, Cannot write Status with constructor " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Status -> FilePath
statusType Status
x


getDatabase :: (BS.ByteString -> Key) -> BS.ByteString -> (Key, Status)
getDatabase :: (OneShot BS_Store -> Key) -> OneShot BS_Store -> (Key, Status)
getDatabase OneShot BS_Store -> Key
getKey OneShot BS_Store
bs
    | (OneShot BS_Store
key, OneShot BS_Store
bs) <- OneShot BS_Store -> (OneShot BS_Store, OneShot BS_Store)
getExN OneShot BS_Store
bs
    , (OneShot BS_Store
x1, OneShot BS_Store
bs) <- OneShot BS_Store -> (OneShot BS_Store, OneShot BS_Store)
getExN OneShot BS_Store
bs
    , (Step
x2, Step
x3, Float
x5, OneShot BS_Store
bs) <- OneShot BS_Store -> (Step, Step, Float, OneShot BS_Store)
forall a b c.
(Storable a, Storable b, Storable c) =>
OneShot BS_Store -> (a, b, c, OneShot BS_Store)
binarySplit3 OneShot BS_Store
bs
    , (OneShot BS_Store
x4, OneShot BS_Store
x6) <- OneShot BS_Store -> (OneShot BS_Store, OneShot BS_Store)
getExN OneShot BS_Store
bs
    = (OneShot BS_Store -> Key
getKey OneShot BS_Store
key, Result (OneShot BS_Store) -> Status
Loaded (OneShot BS_Store
-> Step
-> Step
-> [Depends]
-> Float
-> [Trace]
-> Result (OneShot BS_Store)
forall a.
a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
Result OneShot BS_Store
x1 Step
x2 Step
x3 (OneShot BS_Store -> [Depends]
forall a. BinaryEx a => OneShot BS_Store -> a
getEx OneShot BS_Store
x4) Float
x5 (OneShot BS_Store -> [Trace]
forall a. BinaryEx a => OneShot BS_Store -> a
getEx OneShot BS_Store
x6)))