shake 0.17.4 → 0.17.5

raw patch · 10 files changed

+260/−10 lines, 10 filesdep −heapsPVP ok

version bump matches the API change (PVP)

Dependencies removed: heaps

API changes (from Hackage documentation)

Files

• CHANGES.txt +2/−0
• shake.cabal +4/−4
• src/Development/Shake/Command.hs +1/−1
• src/Development/Shake/Internal/Args.hs +1/−1
• src/Development/Shake/Internal/Core/Build.hs +2/−0
• src/Development/Shake/Internal/Progress.hs +1/−1
• src/General/Binary.hs +1/−1
• src/General/Heap.hs +246/−0
• src/General/Pool.hs +1/−1
• src/Test/Self.hs +1/−1

@@ -1,5 +1,7 @@ Changelog for Shake (* = breaking change) +0.17.5, released 2019-02-05+    Remove dependency on heaps 0.17.4, released 2019-01-10     Add shakeProfileDatabase to generate profile information     Don't suggest -qb (irrelevant with -qg)

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               shake-version:            0.17.4+version:            0.17.5 license:            BSD3 license-file:       LICENSE category:           Development, Shake@@ -89,7 +89,6 @@         extra >= 1.6.1,         filepath,         hashable >= 1.1.2.3,-        heaps,         js-flot,         js-jquery,         primitive,@@ -177,6 +176,7 @@         General.Extra         General.FileLock         General.GetOpt+        General.Heap         General.Ids         General.Intern         General.ListBuilder@@ -208,7 +208,6 @@         extra >= 1.6.1,         filepath,         hashable >= 1.1.2.3,-        heaps,         js-flot,         js-jquery,         primitive,@@ -291,6 +290,7 @@         General.Extra         General.FileLock         General.GetOpt+        General.Heap         General.Ids         General.Intern         General.ListBuilder@@ -327,7 +327,6 @@         extra >= 1.6.1,         filepath,         hashable >= 1.1.2.3,-        heaps,         js-flot,         js-jquery,         primitive,@@ -415,6 +414,7 @@         General.Extra         General.FileLock         General.GetOpt+        General.Heap         General.Ids         General.Intern         General.ListBuilder

@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, TypeOperators, ScopedTypeVariables, NamedFieldPuns #-}+{-# LANGUAGE FlexibleInstances, TypeOperators, ScopedTypeVariables, NamedFieldPuns #-} {-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}  #if __GLASGOW_HASKELL__ < 710

@@ -290,7 +290,7 @@     ,no  $ Option ""  ["numeric-version"] (NoArg $ Right ([NumericVersion],id)) "Print just the version number and exit."     ,yes $ Option ""  ["skip-commands"] (noArg $ \s -> s{shakeRunCommands=False}) "Try and avoid running external programs."     ,yes $ Option ""  ["rebuild"] (OptArg (\x -> Right ([], \s -> s{shakeRebuild=shakeRebuild s ++ [(RebuildNow, fromMaybe "**" x)]})) "PATTERN") "Rebuild matching files."-    ,yes $ Option ""  ["no-rebuild"] (OptArg (\x -> Right ([], \s -> s{shakeRebuild=shakeRebuild s ++ [(RebuildNormal, fromMaybe "**" x)]})) "PATTERN") "Rebuild matching files if necessary."+    ,yes $ Option ""  ["no-rebuild"] (OptArg (\x -> Right ([], \s -> s{shakeRebuild=shakeRebuild s ++ [(RebuildNormal, fromMaybe "**" x)]})) "PATTERN") "Rebuild matching files if necessary (default)."     ,yes $ Option ""  ["skip"] (OptArg (\x -> Right ([], \s -> s{shakeRebuild=shakeRebuild s ++ [(RebuildLater, fromMaybe "**" x)]})) "PATTERN") "Don't rebuild matching files this run." --    ,yes $ Option ""  ["skip-forever"] (OptArg (\x -> Right ([], \s -> s{shakeRebuild=shakeRebuild s ++ [(RebuildNever, fromMaybe "**" x)]})) "PATTERN") "Don't rebuild matching files until they change."     ,yes $ Option "r" ["report","profile"] (OptArg (\x -> Right ([], \s -> s{shakeReport=shakeReport s ++ [fromMaybe "report.html" x]})) "FILE") "Write out profiling information [to report.html]."

@@ -133,6 +133,8 @@                     res <- getIdKeyStatus database i                     w <- case res of                         Just (_, Running (NoShow w) _) -> return w+                        -- FIXME: We know it's possible to arrive here with Error, but we don't know how.+                        --        It can't be easily reproduced.                         _ -> throwM $ errorInternal $ "expected Waiting but got " ++ maybe "nothing" (statusType . snd) res ++ ", key " ++ show k                     setIdKeyStatus global database i k $ either mkError Ready val                     w val

@@ -220,7 +220,7 @@             t <- time             ((secs,perc,_debug), mealy) <- return $ runMealy mealy (t, p)             -- putStrLn _debug-            disp $ formatMessage secs perc ++ maybe "" (\err -> ", Failure! " ++ err) (isFailure p)+            disp $ formatMessage secs perc ++ maybe "" (", Failure! " ++) (isFailure p)             loop time mealy  

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, ExplicitForAll, ScopedTypeVariables, Rank2Types #-}+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, Rank2Types #-}  module General.Binary(     BinaryOp(..), binaryOpMap,

@@ -0,0 +1,246 @@+-- Copied from https://github.com/ekmett/heaps/blob/87c2c8098270d6cf76f1017182c1f7effa8357e6/src/Data/Heap.hs+-- Because I can't depend on 'heaps', see https://github.com/ekmett/heaps/issues/13+-- I removed the CPP++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (c) Edward Kmett 2010-2015+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- An efficient, asymptotically optimal, implementation of a priority queues+-- extended with support for efficient size, and `Data.Foldable`+--+-- /Note/: Since many function names (but not the type name) clash with+-- "Prelude" names, this module is usually imported @qualified@, e.g.+--+-- >  import Data.Heap (Heap)+-- >  import qualified Data.Heap as Heap+--+-- The implementation of 'Heap' is based on /bootstrapped skew binomial heaps/+-- as described by:+--+--    * G. Brodal and C. Okasaki , <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.48.973 "Optimal Purely Functional Priority Queues">,+--      /Journal of Functional Programming/ 6:839-857 (1996)+--+-- All time bounds are worst-case.+-----------------------------------------------------------------------------++module General.Heap+    (+    -- * Heap Type+      Heap -- instance Eq,Ord,Show,Read,Data,Typeable+    -- * Entry type+    , Entry(..) -- instance Eq,Ord,Show,Read,Data,Typeable+    -- * Basic functions+    , empty             -- O(1) :: Heap a+    , insert            -- O(1) :: Ord a => a -> Heap a -> Heap a+    , uncons            -- O(1)\/O(log n) :: Heap a -> Maybe (a, Heap a)+    ) where++import Data.Monoid+import Data.Foldable hiding (minimum, concatMap)+import Data.Function (on)+import Prelude hiding (foldr)++-- The implementation of 'Heap' must internally hold onto the dictionary entry for ('<='),+-- so that it can be made 'Foldable'. Confluence in the absence of incoherent instances+-- is provided by the fact that we only ever build these from instances of 'Ord' a (except in the case of 'groupBy')+++-- | A min-heap of values of type @a@.+data Heap a+  = Empty+  | Heap {-# UNPACK #-} !Int (a -> a -> Bool) {-# UNPACK #-} !(Tree a)++instance Show a => Show (Heap a) where+  showsPrec _ Empty = showString "fromList []"+  showsPrec d (Heap _ _ t) = showParen (d > 10) $+    showString "fromList " .  showsPrec 11 (toList t)++-- | /O(1)/. The empty heap+--+-- @'empty' ≡ 'fromList' []@+--+-- >>> size empty+-- 0+empty :: Heap a+empty = Empty+{-# INLINE empty #-}+++singletonWith :: (a -> a -> Bool) -> a -> Heap a+singletonWith f a = Heap 1 f (Node 0 a Nil)+{-# INLINE singletonWith #-}++-- | /O(1)/. Insert a new value into the heap.+--+-- >>> insert 2 (fromList [1,3])+-- fromList [1,2,3]+--+-- @+-- 'insert' x 'empty' ≡ 'singleton' x+-- 'size' ('insert' x xs) ≡ 1 + 'size' xs+-- @+insert :: Ord a => a -> Heap a -> Heap a+insert = insertWith (<=)+{-# INLINE insert #-}++insertWith :: (a -> a -> Bool) -> a -> Heap a -> Heap a+insertWith leq x Empty = singletonWith leq x+insertWith leq x (Heap s _ t@(Node _ y f))+  | leq x y   = Heap (s+1) leq (Node 0 x (t `Cons` Nil))+  | otherwise = Heap (s+1) leq (Node 0 y (skewInsert leq (Node 0 x Nil) f))+{-# INLINE insertWith #-}+++-- | Provides both /O(1)/ access to the minimum element and /O(log n)/ access to the remainder of the heap.+-- This is the same operation as 'viewMin'+--+-- >>> uncons (fromList [2,1,3])+-- Just (1,fromList [2,3])+uncons :: Heap a -> Maybe (a, Heap a)+uncons Empty = Nothing+uncons l@(Heap _ _ t) = Just (root t, deleteMin l)+{-# INLINE uncons #-}+++trees :: Forest a -> [Tree a]+trees (a `Cons` as) = a : trees as+trees Nil = []++-- | /O(log n)/. Delete the minimum key from the heap and return the resulting heap.+--+-- >>> deleteMin (fromList [3,1,2])+-- fromList [2,3]+deleteMin :: Heap a -> Heap a+deleteMin Empty = Empty+deleteMin (Heap _ _ (Node _ _ Nil)) = Empty+deleteMin (Heap s leq (Node _ _ f0)) = Heap (s - 1) leq (Node 0 x f3)+  where+    (Node r x cf, ts2) = getMin leq f0+    (zs, ts1, f1) = splitForest r Nil Nil cf+    f2 = skewMeld leq (skewMeld leq ts1 ts2) f1+    f3 = foldr (skewInsert leq) f2 (trees zs)+{-# INLINE deleteMin #-}++-- * Subranges++-- we hold onto the children counts in the nodes for /O(1)/ 'size'+data Tree a = Node+  { rank :: {-# UNPACK #-} !Int+  , root :: a+  , _forest :: !(Forest a)+  } deriving (Show)++data Forest a = !(Tree a) `Cons` !(Forest a) | Nil+  deriving (Show)+infixr 5 `Cons`++instance Functor Tree where+  fmap f (Node r a as) = Node r (f a) (fmap f as)++instance Functor Forest where+  fmap f (a `Cons` as) = fmap f a `Cons` fmap f as+  fmap _ Nil = Nil++-- internal foldable instances that should only be used over commutative monoids+instance Foldable Tree where+  foldMap f (Node _ a as) = f a `mappend` foldMap f as++-- internal foldable instances that should only be used over commutative monoids+instance Foldable Forest where+  foldMap f (a `Cons` as) = foldMap f a `mappend` foldMap f as+  foldMap _ Nil = mempty++link :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a+link f t1@(Node r1 x1 cf1) t2@(Node r2 x2 cf2) -- assumes r1 == r2+  | f x1 x2   = Node (r1+1) x1 (t2 `Cons` cf1)+  | otherwise = Node (r2+1) x2 (t1 `Cons` cf2)++skewLink :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a+skewLink f t0@(Node _ x0 cf0) t1@(Node r1 x1 cf1) t2@(Node r2 x2 cf2)+  | f x1 x0 && f x1 x2 = Node (r1+1) x1 (t0 `Cons` t2 `Cons` cf1)+  | f x2 x0 && f x2 x1 = Node (r2+1) x2 (t0 `Cons` t1 `Cons` cf2)+  | otherwise          = Node (r1+1) x0 (t1 `Cons` t2 `Cons` cf0)++ins :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a+ins _ t Nil = t `Cons` Nil+ins f t (t' `Cons` ts) -- assumes rank t <= rank t'+  | rank t < rank t' = t `Cons` t' `Cons` ts+  | otherwise = ins f (link f t t') ts++uniqify :: (a -> a -> Bool) -> Forest a -> Forest a+uniqify _ Nil = Nil+uniqify f (t `Cons` ts) = ins f t ts++unionUniq :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a+unionUniq _ Nil ts = ts+unionUniq _ ts Nil = ts+unionUniq f tts1@(t1 `Cons` ts1) tts2@(t2 `Cons` ts2) = case compare (rank t1) (rank t2) of+  LT -> t1 `Cons` unionUniq f ts1 tts2+  EQ -> ins f (link f t1 t2) (unionUniq f ts1 ts2)+  GT -> t2 `Cons` unionUniq f tts1 ts2++skewInsert :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a+skewInsert f t ts@(t1 `Cons` t2 `Cons`rest)+  | rank t1 == rank t2 = skewLink f t t1 t2 `Cons` rest+  | otherwise = t `Cons` ts+skewInsert _ t ts = t `Cons` ts+{-# INLINE skewInsert #-}++skewMeld :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a+skewMeld f ts ts' = unionUniq f (uniqify f ts) (uniqify f ts')+{-# INLINE skewMeld #-}++getMin :: (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)+getMin _ (t `Cons` Nil) = (t, Nil)+getMin f (t `Cons` ts)+  | f (root t) (root t') = (t, ts)+  | otherwise            = (t', t `Cons` ts')+  where (t',ts') = getMin f ts+getMin _ Nil = error "Heap.getMin: empty forest"++splitForest :: Int -> Forest a -> Forest a -> Forest a -> (Forest a, Forest a, Forest a)+splitForest a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined+splitForest 0 zs ts f = (zs, ts, f)+splitForest 1 zs ts (t `Cons` Nil) = (zs, t `Cons` ts, Nil)+splitForest 1 zs ts (t1 `Cons` t2 `Cons` f)+  -- rank t1 == 0+  | rank t2 == 0 = (t1 `Cons` zs, t2 `Cons` ts, f)+  | otherwise    = (zs, t1 `Cons` ts, t2 `Cons` f)+splitForest r zs ts (t1 `Cons` t2 `Cons` cf)+  -- r1 = r - 1 or r1 == 0+  | r1 == r2          = (zs, t1 `Cons` t2 `Cons` ts, cf)+  | r1 == 0           = splitForest (r-1) (t1 `Cons` zs) (t2 `Cons` ts) cf+  | otherwise         = splitForest (r-1) zs (t1 `Cons` ts) (t2 `Cons` cf)+  where+    r1 = rank t1+    r2 = rank t2+splitForest _ _ _ _ = error "Heap.splitForest: invalid arguments"+++-- | Explicit priority/payload tuples. Useful to build a priority queue using+-- a 'Heap', since the payload is ignored in the Eq/Ord instances.+--+-- @+-- myHeap = 'fromList' ['Entry' 2 \"World", 'Entry' 1 \"Hello", 'Entry' 3 "!"]+--+-- ==> 'foldMap' 'payload' myHeap ≡ "HelloWorld!"+-- @+data Entry p a = Entry { priority :: p, payload :: a }+  deriving (Show)++-- instance Comonad (Entry p) where+--   extract (Entry _ a) = a+--   extend f pa@(Entry p _) Entry p (f pa)++instance Eq p => Eq (Entry p a) where+  (==) = (==) `on` priority+  {-# INLINE (==) #-}++instance Ord p => Ord (Entry p a) where+  compare = compare `on` priority+  {-# INLINE compare #-}

@@ -23,7 +23,7 @@ import Control.Monad.Extra import General.Timing import General.Extra-import qualified Data.Heap as Heap+import qualified General.Heap as Heap import qualified Data.HashSet as Set import Data.IORef.Extra import System.Random

@@ -87,7 +87,7 @@ cabalBuildDepends _ = packages ++ ["unix" | os /= "mingw32"]  packages = words-    ("base transformers binary unordered-containers hashable heaps time bytestring primitive " +++    ("base transformers binary unordered-containers hashable time bytestring primitive " ++      "filepath directory process deepseq random utf8-string extra js-jquery js-flot") ++     ["old-time" | compilerVersion < makeVersion [7,6]] ++     ["semigroups" | compilerVersion < makeVersion [8,0]]