diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,2 +1,2 @@ # hw-fingertree-strict -[![CircleCI](https://circleci.com/gh/haskell-works/hw-fingertree-strict.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-fingertree-strict) +[![Binaries](https://github.com/haskell-works/hw-fingertree-strict/actions/workflows/haskell.yml/badge.svg)](https://github.com/haskell-works/hw-fingertree-strict/actions/workflows/haskell.yml) diff --git a/hw-fingertree-strict.cabal b/hw-fingertree-strict.cabal --- a/hw-fingertree-strict.cabal +++ b/hw-fingertree-strict.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-fingertree-strict -version: 0.1.2.0 +version: 0.1.2.1 synopsis: Generic strict finger-tree structure description: A general sequence representation with arbitrary annotations, for use as a base for implementations of @@ -21,11 +21,11 @@ bug-reports: https://github.com/haskell-works/hw-fingertree-strict/issues author: John Ky maintainer: newhoggy@gmail.com -copyright: 2017-2020 John Ky; +copyright: 2017-2021 John Ky; 2006 Ross Paterson, Ralf Hinze license: BSD-3-Clause license-file: LICENSE -tested-with: GHC == 8.10.1, GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4 +tested-with: GHC == 9.2.2, GHC == 9.0.2, GHC == 8.10.7, GHC == 8.8.4, GHC == 8.6.5 build-type: Simple extra-source-files: README.md @@ -33,19 +33,19 @@ type: git location: https://github.com/haskell-works/hw-fingertree-strict -common base { build-depends: base >= 4.11 && < 5 } +common base { build-depends: base >= 4.11 && < 5 } -common deepseq { build-depends: deepseq >= 1.4 && < 1.5 } -common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } -common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } -common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } -common hspec { build-depends: hspec >= 2.4 && < 2.8 } -common HUnit { build-depends: HUnit >= 1.5 && < 1.7 } -common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } -common QuickCheck { build-depends: QuickCheck >= 2.10 && < 2.15 } -common test-framework { build-depends: test-framework } -common test-framework-hunit { build-depends: test-framework-hunit } -common test-framework-quickcheck2 { build-depends: test-framework-quickcheck2 } +common deepseq { build-depends: deepseq >= 1.4 && < 1.5 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.21 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +common hedgehog { build-depends: hedgehog >= 0.6 && < 1.2 } +common hspec { build-depends: hspec >= 2.4 && < 2.10 } +common HUnit { build-depends: HUnit >= 1.5 && < 1.7 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } +common QuickCheck { build-depends: QuickCheck >= 2.10 && < 2.15 } +common test-framework { build-depends: test-framework >= 0.8.2.0 && < 0.9 } +common test-framework-hunit { build-depends: test-framework-hunit >= 0.3.0.2 && < 0.4 } +common test-framework-quickcheck2 { build-depends: test-framework-quickcheck2 >= 0.3.0.5 && < 0.4 } common hw-fingertree-strict build-depends: hw-fingertree-strict @@ -102,7 +102,7 @@ , hw-fingertree-strict default-language: Haskell2010 type: exitcode-stdio-1.0 - ghc-options: -threaded + ghc-options: -threaded -rtsopts -with-rtsopts=-N main-is: DoctestDriver.hs HS-Source-Dirs: doctest build-tool-depends: doctest-discover:doctest-discover diff --git a/src/HaskellWorks/Data/FingerTree/Strict.hs b/src/HaskellWorks/Data/FingerTree/Strict.hs --- a/src/HaskellWorks/Data/FingerTree/Strict.hs +++ b/src/HaskellWorks/Data/FingerTree/Strict.hs @@ -3,14 +3,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.FingerTree @@ -75,6 +69,9 @@ infixr 5 <|, :< infixl 5 |>, :> +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Use record patterns" -} + -- | View of the left end of a sequence. data ViewL s a = EmptyL -- ^ empty sequence @@ -104,10 +101,7 @@ instance Measured v a => Monoid (FingerTree v a) where mempty = empty {-# INLINE mempty #-} - mappend = (><) - {-# INLINE mappend #-} - -- Explicit Digit type (Exercise 1) data Digit a @@ -389,7 +383,7 @@ consDigit a (One b) = Two a b consDigit a (Two b c) = Three a b c consDigit a (Three b c d) = Four a b c d -consDigit _ (Four _ _ _ _) = illegal_argument "consDigit" +consDigit _ (Four _ _ _ _) = illegalArgument "consDigit" -- | /O(1)/. Add an element to the right end of a sequence. -- Mnemonic: a triangle with the single element at the pointy end. @@ -405,7 +399,7 @@ snocDigit (One a) b = Two a b snocDigit (Two a b) c = Three a b c snocDigit (Three a b c) d = Four a b c d -snocDigit (Four _ _ _ _) _ = illegal_argument "snocDigit" +snocDigit (Four _ _ _ _) _ = illegalArgument "snocDigit" -- | /O(1)/. Is this the empty sequence? null :: FingerTree v a -> Bool @@ -431,7 +425,7 @@ lheadDigit (Four a _ _ _) = a ltailDigit :: Digit a -> Digit a -ltailDigit (One _) = illegal_argument "ltailDigit" +ltailDigit (One _) = illegalArgument "ltailDigit" ltailDigit (Two _ b) = One b ltailDigit (Three _ b c) = Two b c ltailDigit (Four _ b c d) = Three b c d @@ -455,7 +449,7 @@ rheadDigit (Four _ _ _ d) = d rtailDigit :: Digit a -> Digit a -rtailDigit (One _) = illegal_argument "rtailDigit" +rtailDigit (One _) = illegalArgument "rtailDigit" rtailDigit (Two a _) = One a rtailDigit (Three a b _) = Two a b rtailDigit (Four a b c _) = Three a b c @@ -742,7 +736,7 @@ splitTree :: Measured v a => (v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a -splitTree _ _ Empty = illegal_argument "splitTree" +splitTree _ _ Empty = illegalArgument "splitTree" splitTree _ _ (Single x) = Split Empty x Empty splitTree p i (Deep _ pr m sf) | p vpr = let Split l x r = splitDigit p i pr @@ -835,9 +829,8 @@ reverseDigit f (Three a b c) = Three (f c) (f b) (f a) reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a) -illegal_argument :: String -> a -illegal_argument name = - error $ "Logic error: " ++ name ++ " called with illegal argument" +illegalArgument :: String -> a +illegalArgument name = error $ "Logic error: " <> name <> " called with illegal argument" maybeHead :: Measured v a => FingerTree v a -> Maybe a maybeHead zs = case viewl zs of diff --git a/src/HaskellWorks/Data/IntervalMap/Strict.hs b/src/HaskellWorks/Data/IntervalMap/Strict.hs --- a/src/HaskellWorks/Data/IntervalMap/Strict.hs +++ b/src/HaskellWorks/Data/IntervalMap/Strict.hs @@ -2,12 +2,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.IntervalMap.Strict @@ -84,8 +79,8 @@ deriving (Eq, Show, Generic, NFData) appendInterval :: Ord v => IntInterval v -> IntInterval v -> IntInterval v -appendInterval (NoInterval ) (i ) = i -appendInterval (i ) (NoInterval ) = i +appendInterval NoInterval i = i +appendInterval i NoInterval = i appendInterval (IntInterval _ hi1) (IntInterval int2 hi2) = IntInterval int2 (max hi1 hi2) {-# INLINE appendInterval #-} @@ -96,8 +91,6 @@ instance Ord v => Monoid (IntInterval v) where mempty = NoInterval {-# INLINE mempty #-} - mappend = appendInterval - {-# INLINE mappend #-} instance (Ord v) => Measured (IntInterval v) (Node v a) where measure (Node i _) = IntInterval i (high i) diff --git a/src/HaskellWorks/Data/PriorityQueue/Strict.hs b/src/HaskellWorks/Data/PriorityQueue/Strict.hs --- a/src/HaskellWorks/Data/PriorityQueue/Strict.hs +++ b/src/HaskellWorks/Data/PriorityQueue/Strict.hs @@ -1,11 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.PriorityQueue.FingerTree @@ -58,6 +53,7 @@ import Control.Arrow ((***)) import Control.DeepSeq (NFData) +import Data.Bifunctor (first) import Data.Foldable (Foldable (foldMap)) import GHC.Generics (Generic) import HaskellWorks.Data.FingerTree.Strict (FingerTree, Measured (..), ViewL (..), (<|), (><), (|>)) @@ -89,8 +85,6 @@ instance Ord k => Monoid (Prio k v) where mempty = NoPrio {-# INLINE mempty #-} - mappend = appendPrio - {-# INLINE mappend #-} instance Ord k => Measured (Prio k v) (Entry k v) where measure (Entry k v) = Prio k v @@ -168,7 +162,7 @@ -- * @'minView' ('singleton' k v) = 'Just' (v, 'empty')@ -- minView :: Ord k => PQueue k v -> Maybe (v, PQueue k v) -minView q = fmap (snd *** id) (minViewWithKey q) +minView q = fmap (first snd) (minViewWithKey q) -- | /O(n)/ for number of elements taken. takeWithKeys :: Ord k => Int -> PQueue k v -> ([(k, v)], PQueue k v) diff --git a/src/HaskellWorks/Data/SegmentMap/Strict.hs b/src/HaskellWorks/Data/SegmentMap/Strict.hs --- a/src/HaskellWorks/Data/SegmentMap/Strict.hs +++ b/src/HaskellWorks/Data/SegmentMap/Strict.hs @@ -5,12 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 702 --- {-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.SegmentMap.Strict diff --git a/src/HaskellWorks/Data/SegmentSet/Strict.hs b/src/HaskellWorks/Data/SegmentSet/Strict.hs --- a/src/HaskellWorks/Data/SegmentSet/Strict.hs +++ b/src/HaskellWorks/Data/SegmentSet/Strict.hs @@ -4,12 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 702 --- {-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.SegmentSet.Strict @@ -72,7 +67,7 @@ import qualified HaskellWorks.Data.FingerTree.Strict as FT -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{- HLINT ignore "Reduce duplication" -} infixr 5 >*< diff --git a/test/HaskellWorks/Data/FingerTree/Gen.hs b/test/HaskellWorks/Data/FingerTree/Gen.hs --- a/test/HaskellWorks/Data/FingerTree/Gen.hs +++ b/test/HaskellWorks/Data/FingerTree/Gen.hs @@ -11,6 +11,8 @@ import qualified Hedgehog.Internal.Shrink as S import qualified Hedgehog.Range as R +{- HLINT ignore "Use <=<" -} + genList :: MonadGen m => Range Int -> m a -> m [a] genList range gen = G.sized $ \size -> diff --git a/test/HaskellWorks/Data/FingerTree/Strict/Gen.hs b/test/HaskellWorks/Data/FingerTree/Strict/Gen.hs --- a/test/HaskellWorks/Data/FingerTree/Strict/Gen.hs +++ b/test/HaskellWorks/Data/FingerTree/Strict/Gen.hs @@ -11,6 +11,8 @@ import qualified Hedgehog.Internal.Shrink as S import qualified Hedgehog.Range as R +{- HLINT ignore "Use <=<" -} + genList :: MonadGen m => Range Int -> m a -> m [a] genList range gen = G.sized $ \size -> diff --git a/test/HaskellWorks/Data/FingerTree/StrictSpec.hs b/test/HaskellWorks/Data/FingerTree/StrictSpec.hs --- a/test/HaskellWorks/Data/FingerTree/StrictSpec.hs +++ b/test/HaskellWorks/Data/FingerTree/StrictSpec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} module HaskellWorks.Data.FingerTree.StrictSpec (spec) where @@ -21,9 +22,9 @@ import qualified Hedgehog.Range as R import qualified Prelude as P -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} spec :: Spec spec = do @@ -137,14 +138,13 @@ evalM m = snd (runM m 0) instance Monad M where - return x = M $ \ n -> (n, x) M u >>= f = M $ \ m -> let (n, x) = u m in runM (f x) n instance Functor M where fmap f (M u) = M $ \ m -> let (n, x) = u m in (n, f x) instance Applicative M where - pure = return + pure x = M (, x) (<*>) = ap step :: M Int @@ -156,6 +156,7 @@ toListPair' (xs, ys) = (,) <$> toList' xs <*> toList' ys toList' :: (Eq a, Measured [a] a, Valid a) => Seq a -> Maybe [a] + toList' xs | valid xs = Just (toList xs) | otherwise = Nothing diff --git a/test/HaskellWorks/Data/FingerTreeSpec.hs b/test/HaskellWorks/Data/FingerTreeSpec.hs --- a/test/HaskellWorks/Data/FingerTreeSpec.hs +++ b/test/HaskellWorks/Data/FingerTreeSpec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} module HaskellWorks.Data.FingerTreeSpec (spec) where @@ -21,9 +22,9 @@ import qualified Hedgehog.Range as R import qualified Prelude as P -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} spec :: Spec spec = do @@ -137,14 +138,13 @@ evalM m = snd (runM m 0) instance Monad M where - return x = M $ \ n -> (n, x) M u >>= f = M $ \ m -> let (n, x) = u m in runM (f x) n instance Functor M where fmap f (M u) = M $ \ m -> let (n, x) = u m in (n, f x) instance Applicative M where - pure = return + pure x = M (, x) (<*>) = ap step :: M Int diff --git a/test/HaskellWorks/Data/SegmentMap/StrictSpec.hs b/test/HaskellWorks/Data/SegmentMap/StrictSpec.hs --- a/test/HaskellWorks/Data/SegmentMap/StrictSpec.hs +++ b/test/HaskellWorks/Data/SegmentMap/StrictSpec.hs @@ -21,7 +21,7 @@ import Hedgehog import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{- HLINT ignore "Redundant do" -} fallbackTo :: Bool fallbackTo = True diff --git a/test/HaskellWorks/Data/SegmentSet/NaiveSpec.hs b/test/HaskellWorks/Data/SegmentSet/NaiveSpec.hs --- a/test/HaskellWorks/Data/SegmentSet/NaiveSpec.hs +++ b/test/HaskellWorks/Data/SegmentSet/NaiveSpec.hs @@ -5,7 +5,7 @@ import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{- HLINT ignore "Redundant do" -} rawIps :: [Segment Int] rawIps = [Segment 12 20, Segment 1 10, Segment 220 300] diff --git a/test/HaskellWorks/Data/SegmentSet/StrictSpec.hs b/test/HaskellWorks/Data/SegmentSet/StrictSpec.hs --- a/test/HaskellWorks/Data/SegmentSet/StrictSpec.hs +++ b/test/HaskellWorks/Data/SegmentSet/StrictSpec.hs @@ -6,7 +6,7 @@ ) where import Data.Foldable -import Data.List (sortBy) +import Data.List (sortBy) import Control.Monad.IO.Class import Data.Semigroup @@ -24,7 +24,7 @@ import Hedgehog import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{- HLINT ignore "Redundant do" -} fallbackTo :: Bool fallbackTo = True