{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module NvFetcher.Types.ShakeExtras
(
ShakeExtras (..),
initShakeExtras,
getShakeExtras,
lookupPackage,
getAllPackageKeys,
isPackageKeyTarget,
recordVersionChange,
getVersionChanges,
withRetries,
)
where
import Control.Concurrent.Extra
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Development.Shake
import NvFetcher.Types
data =
{ ShakeExtras -> Var [VersionChange]
versionChanges :: Var [VersionChange],
ShakeExtras -> Map PackageKey Package
targetPackages :: Map PackageKey Package,
ShakeExtras -> Int
retries :: Int
}
getShakeExtras :: Action ShakeExtras
=
Typeable ShakeExtras => Action (Maybe ShakeExtras)
forall a. Typeable a => Action (Maybe a)
getShakeExtra @ShakeExtras Action (Maybe ShakeExtras)
-> (Maybe ShakeExtras -> Action ShakeExtras) -> Action ShakeExtras
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ShakeExtras
x -> ShakeExtras -> Action ShakeExtras
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeExtras
x
Maybe ShakeExtras
_ -> String -> Action ShakeExtras
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ShakeExtras is missing!"
initShakeExtras :: Map PackageKey Package -> Int -> IO ShakeExtras
Map PackageKey Package
targetPackages Int
retries = do
Var [VersionChange]
versionChanges <- [VersionChange] -> IO (Var [VersionChange])
forall a. a -> IO (Var a)
newVar [VersionChange]
forall a. Monoid a => a
mempty
ShakeExtras -> IO ShakeExtras
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeExtras :: Var [VersionChange] -> Map PackageKey Package -> Int -> ShakeExtras
ShakeExtras {Int
Map PackageKey Package
Var [VersionChange]
versionChanges :: Var [VersionChange]
retries :: Int
targetPackages :: Map PackageKey Package
retries :: Int
targetPackages :: Map PackageKey Package
versionChanges :: Var [VersionChange]
..}
getAllPackageKeys :: Action [PackageKey]
getAllPackageKeys :: Action [PackageKey]
getAllPackageKeys = do
ShakeExtras {Int
Map PackageKey Package
Var [VersionChange]
retries :: Int
targetPackages :: Map PackageKey Package
versionChanges :: Var [VersionChange]
retries :: ShakeExtras -> Int
targetPackages :: ShakeExtras -> Map PackageKey Package
versionChanges :: ShakeExtras -> Var [VersionChange]
..} <- Action ShakeExtras
getShakeExtras
[PackageKey] -> Action [PackageKey]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageKey] -> Action [PackageKey])
-> [PackageKey] -> Action [PackageKey]
forall a b. (a -> b) -> a -> b
$ Map PackageKey Package -> [PackageKey]
forall k a. Map k a -> [k]
Map.keys Map PackageKey Package
targetPackages
lookupPackage :: PackageKey -> Action (Maybe Package)
lookupPackage :: PackageKey -> Action (Maybe Package)
lookupPackage PackageKey
key = do
ShakeExtras {Int
Map PackageKey Package
Var [VersionChange]
retries :: Int
targetPackages :: Map PackageKey Package
versionChanges :: Var [VersionChange]
retries :: ShakeExtras -> Int
targetPackages :: ShakeExtras -> Map PackageKey Package
versionChanges :: ShakeExtras -> Var [VersionChange]
..} <- Action ShakeExtras
getShakeExtras
Maybe Package -> Action (Maybe Package)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Package -> Action (Maybe Package))
-> Maybe Package -> Action (Maybe Package)
forall a b. (a -> b) -> a -> b
$ PackageKey -> Map PackageKey Package -> Maybe Package
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageKey
key Map PackageKey Package
targetPackages
isPackageKeyTarget :: PackageKey -> Action Bool
isPackageKeyTarget :: PackageKey -> Action Bool
isPackageKeyTarget PackageKey
k = PackageKey -> Map PackageKey Package -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PackageKey
k (Map PackageKey Package -> Bool)
-> (ShakeExtras -> Map PackageKey Package) -> ShakeExtras -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeExtras -> Map PackageKey Package
targetPackages (ShakeExtras -> Bool) -> Action ShakeExtras -> Action Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action ShakeExtras
getShakeExtras
recordVersionChange :: PackageName -> Maybe Version -> Version -> Action ()
recordVersionChange :: PackageName -> Maybe Version -> Version -> Action ()
recordVersionChange PackageName
vcName Maybe Version
vcOld Version
vcNew = do
ShakeExtras {Int
Map PackageKey Package
Var [VersionChange]
retries :: Int
targetPackages :: Map PackageKey Package
versionChanges :: Var [VersionChange]
retries :: ShakeExtras -> Int
targetPackages :: ShakeExtras -> Map PackageKey Package
versionChanges :: ShakeExtras -> Var [VersionChange]
..} <- Action ShakeExtras
getShakeExtras
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Var [VersionChange]
-> ([VersionChange] -> IO [VersionChange]) -> IO ()
forall a. Var a -> (a -> IO a) -> IO ()
modifyVar_ Var [VersionChange]
versionChanges ([VersionChange] -> IO [VersionChange]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VersionChange] -> IO [VersionChange])
-> ([VersionChange] -> [VersionChange])
-> [VersionChange]
-> IO [VersionChange]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VersionChange] -> [VersionChange] -> [VersionChange]
forall a. [a] -> [a] -> [a]
++ [VersionChange :: PackageName -> Maybe Version -> Version -> VersionChange
VersionChange {Maybe Version
PackageName
Version
vcNew :: Version
vcOld :: Maybe Version
vcName :: PackageName
vcNew :: Version
vcOld :: Maybe Version
vcName :: PackageName
..}]))
getVersionChanges :: Action [VersionChange]
getVersionChanges :: Action [VersionChange]
getVersionChanges = do
ShakeExtras {Int
Map PackageKey Package
Var [VersionChange]
retries :: Int
targetPackages :: Map PackageKey Package
versionChanges :: Var [VersionChange]
retries :: ShakeExtras -> Int
targetPackages :: ShakeExtras -> Map PackageKey Package
versionChanges :: ShakeExtras -> Var [VersionChange]
..} <- Action ShakeExtras
getShakeExtras
IO [VersionChange] -> Action [VersionChange]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VersionChange] -> Action [VersionChange])
-> IO [VersionChange] -> Action [VersionChange]
forall a b. (a -> b) -> a -> b
$ Var [VersionChange] -> IO [VersionChange]
forall a. Var a -> IO a
readVar Var [VersionChange]
versionChanges
withRetries :: Action a -> Action a
withRetries :: Action a -> Action a
withRetries Action a
a = Action ShakeExtras
getShakeExtras Action ShakeExtras -> (ShakeExtras -> Action a) -> Action a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ShakeExtras {Int
Map PackageKey Package
Var [VersionChange]
retries :: Int
targetPackages :: Map PackageKey Package
versionChanges :: Var [VersionChange]
retries :: ShakeExtras -> Int
targetPackages :: ShakeExtras -> Map PackageKey Package
versionChanges :: ShakeExtras -> Var [VersionChange]
..} -> Int -> Action a -> Action a
forall a. Int -> Action a -> Action a
actionRetry Int
retries Action a
a