rock 0.1.0.1 → 0.2.0.0

raw patch · 7 files changed

+63/−81 lines, 7 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−2
• rock.cabal +2/−3
• src/Rock.hs +0/−2
• src/Rock/Core.hs +41/−9
• src/Rock/HashTag.hs +0/−19
• src/Rock/Hashed.hs +0/−30
• src/Rock/Traces.hs +13/−16

@@ -1,9 +1,14 @@ # Unreleased -# 0.1.0.0+# 0.2.0.0 -- Initial release+- Stop using hashes when verifying traces (gets rid of the `Rock.HashTag` and `Rock.Hashed` modules)+- Add reverse dependency tracking  # 0.1.0.1  - Fix base-4.12 compatibility++# 0.1.0.0++- Initial release

@@ -1,5 +1,5 @@ name:                rock-version:             0.1.0.1+version:             0.2.0.0 synopsis:            A build system for incremental, parallel, and demand-driven computations description:         See <https://www.github.com/ollef/rock> for more                      information and@@ -33,10 +33,9 @@   exposed-modules:                        Rock                        Rock.Core-                       Rock.HashTag-                       Rock.Hashed                        Rock.Traces   build-depends:       base >= 4.7 && < 5+                     , containers                      , dependent-map                      , dependent-sum                      , deriving-compat

@@ -1,9 +1,7 @@ module Rock   ( module Rock.Core-  , module Rock.HashTag   , Traces   ) where  import Rock.Core-import Rock.HashTag import Rock.Traces

@@ -1,11 +1,11 @@ {-# language CPP #-} {-# language DefaultSignatures #-} {-# language DeriveFunctor #-}+{-# language FlexibleContexts #-} {-# language FlexibleInstances #-} {-# language FunctionalDependencies #-} {-# language GADTs #-} {-# language GeneralizedNewtypeDeriving #-}-{-# language MultiParamTypeClasses #-} {-# language RankNTypes #-} {-# language ScopedTypeVariables #-} {-# language UndecidableInstances #-}@@ -28,10 +28,12 @@ import qualified Control.Monad.Writer.Strict as Strict import Data.Dependent.Map(DMap, GCompare) import qualified Data.Dependent.Map as DMap+import Data.Dependent.Sum import Data.GADT.Compare+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Some -import Rock.Hashed-import Rock.HashTag import Rock.Traces(Traces) import qualified Rock.Traces as Traces @@ -276,9 +278,9 @@ -- were then. -- -- If all dependencies of a 'NonInput' query are the same, reuse the old result.--- The 'DMap' _can_ be reused if there are changes to 'Input' queries.+-- 'Input' queries are not reused. verifyTraces-  :: (GCompare f, HashTag f)+  :: (EqTag f Identity, GCompare f)   => MVar (Traces f)   -> GenRules (Writer TaskKind f) f   -> Rules f@@ -287,7 +289,7 @@   maybeValue <- case DMap.lookup key traces of     Nothing -> return Nothing     Just oldValueDeps ->-      Traces.verifyDependencies fetchHashed oldValueDeps+      Traces.verifyDependencies fetch oldValueDeps   case maybeValue of     Nothing -> do       ((value, taskKind), deps) <- track $ rules $ Writer key@@ -300,9 +302,6 @@             . Traces.record key value deps       return value     Just value -> return value-  where-    fetchHashed :: HashTag f => f a -> Task f (Hashed a)-    fetchHashed key' = hashed key' <$> fetch key'  data TaskKind   = Input -- ^ Used for tasks whose results can change independently of their fetched dependencies, i.e. inputs.@@ -348,3 +347,36 @@   result <- rules key   after key result   return result++type ReverseDependencies f = Map (Some f) (Set (Some f))++-- | Write reverse dependencies to the 'MVar'.+trackReverseDependencies+  :: GCompare f+  => MVar (ReverseDependencies f)+  -> Rules f+  -> Rules f+trackReverseDependencies reverseDepsVar rules key = do+  (res, deps) <- track $ rules key+  unless (DMap.null deps) $ do+    let newReverseDeps = Map.fromListWith (<>)+          [ (This depKey, Set.singleton $ This key)+          | depKey DMap.:=> _ <- DMap.toList deps+          ]+    liftIO $ modifyMVar_ reverseDepsVar $ pure . Map.unionWith (<>) newReverseDeps+  pure res++-- | @'invalidateReverseDependencies' key@ removes all keys reachable, by+-- reverse dependency, from @key@ from the input 'DMap'. It also returns the+-- reverse dependency map with those same keys removed.+invalidateReverseDependencies+  :: GCompare f+  => f a+  -> ReverseDependencies f+  -> DMap f g+  -> (ReverseDependencies f, DMap f g)+invalidateReverseDependencies key reverseDeps m =+  foldl'+    (\(reverseDeps', m') (This key') -> invalidateReverseDependencies key' reverseDeps' m')+    (Map.delete (This key) reverseDeps, DMap.delete key m)+    (Set.toList $ Map.findWithDefault mempty (This key) reverseDeps)

@@ -1,19 +0,0 @@-module Rock.HashTag where--import Protolude---- | Hash the result of a @k@ query.------ A typical implementation looks like:------ @--- data Query a where---   ReadFile :: 'FilePath' -> Query 'Text'------ instance 'HashTag' Query where---   'hashTagged' query =---     case query of---       ReadFile {} -> 'hash'--- @-class HashTag k where-  hashTagged :: k a -> a -> Int

@@ -1,30 +0,0 @@-module Rock.Hashed(Hashed, hashed, unhashed) where--import Protolude--import Data.Functor.Classes-import Text.Show--import Rock.HashTag--data Hashed a = Hashed !a !Int-  deriving (Show)--instance Eq a => Eq (Hashed a) where-  Hashed v1 h1 == Hashed v2 h2 = h1 == h2 && v1 == v2--instance Ord a => Ord (Hashed a) where-  compare (Hashed v1 _) (Hashed v2 _) = compare v1 v2--instance Show1 Hashed where-  liftShowsPrec showa _ d (Hashed a _) = showParen (d > 10)-    $ showString "Hashed " . showa 11 a--instance Hashable (Hashed a) where-  hashWithSalt s (Hashed _ h) = hashWithSalt s h--unhashed :: Hashed a -> a-unhashed (Hashed x _) = x--hashed :: HashTag f => f a -> a -> Hashed a-hashed k v = Hashed v $ hashTagged k v

@@ -1,3 +1,4 @@+{-# language FlexibleContexts #-} {-# language RankNTypes #-} {-# language StandaloneDeriving #-} {-# language TemplateHaskell #-}@@ -12,34 +13,31 @@ import Data.Functor.Classes import Text.Show.Deriving -import Rock.HashTag-import Rock.Hashed- data ValueDeps f a = ValueDeps-  { value :: !(Hashed a)-  , dependencies :: !(DMap f Hashed)+  { value :: !a+  , dependencies :: !(DMap f Identity)   }  return [] -deriving instance (Show a, ShowTag f Hashed) => Show (ValueDeps f a)+deriving instance (ShowTag f Identity, Show a) => Show (ValueDeps f a) -instance ShowTag f Hashed => Show1 (ValueDeps f) where+instance ShowTag f Identity => Show1 (ValueDeps f) where   liftShowsPrec = $(makeLiftShowsPrec ''ValueDeps)  type Traces f = DMap f (ValueDeps f)  verifyDependencies-  :: Monad m-  => (forall a'. f a' -> m (Hashed a'))+  :: (Monad m, EqTag f Identity)+  => (forall a'. f a' -> m a')   -> ValueDeps f a   -> m (Maybe a)-verifyDependencies fetchHash (ValueDeps hashedValue deps) = do+verifyDependencies fetch (ValueDeps value_ deps) = do   upToDate <- allM (DMap.toList deps) $ \(depKey :=> depValue) -> do-    depValue' <- fetchHash depKey-    return $ hash depValue == hash depValue'+    depValue' <- fetch depKey+    return $ eqTagged depKey depKey depValue $ Identity depValue'   return $ if upToDate-    then Just $ unhashed hashedValue+    then Just value_     else Nothing   where     allM :: Monad m => [a] -> (a -> m Bool) -> m Bool@@ -52,7 +50,7 @@         return False  record-  :: (GCompare f, HashTag f)+  :: GCompare f   => f a   -> a   -> DMap f Identity@@ -60,5 +58,4 @@   -> Traces f record k v deps   = DMap.insert k-  $ ValueDeps (hashed k v)-  $ DMap.mapWithKey (\k' (Identity v') -> hashed k' v') deps+  $ ValueDeps v deps