diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,32 @@ dist -tags +dist-newstyle +docs +wiki TAGS +tags +wip +.DS_Store +.*.swp +.*.swo +*.o +*.hi +*~ +*# +.stack-work/ +cabal-dev +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,4 @@ +- arguments: [-XCPP, --cpp-define=HLINT, --cpp-ansi] + +- ignore: {name: Use infix} +- ignore: {name: Use fmap} diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 --- a/.travis.yml +++ /dev/null @@ -1,62 +0,0 @@ -# NB: don't set `language: haskell` here - -# See also https://github.com/hvr/multi-ghc-travis for more information -env: - # we have to use CABALVER=1.16 for GHC<7.6 as well, as there's - # no package for earlier cabal versions in the PPA - - GHCVER=7.4.2 CABALVER=1.16 - - GHCVER=7.6.3 CABALVER=1.16 - - GHCVER=7.8.4 CABALVER=1.18 - - GHCVER=7.10.1 CABALVER=1.22 - - GHCVER=head CABALVER=1.22 - -matrix: - allow_failures: - - env: GHCVER=head CABALVER=1.22 - -# Note: the distinction between `before_install` and `install` is not -# important. -before_install: - - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - - cabal --version - -install: - - travis_retry cabal update - - cabal install --only-dependencies - - travis_retry sudo apt-get -q -y install hlint || cabal install hlint - -# Here starts the actual work to be performed for the package under -# test; any command which exits with a non-zero exit code causes the -# build to fail. -script: - # -v2 provides useful information for debugging - - cabal configure -v2 - - # this builds all libraries and executables - # (including tests/benchmarks) - - cabal build - - # tests that a source-distribution can be generated - - cabal sdist - - hlint src --cpp-define HLINT - - # check that the generated source-distribution can be built & installed - - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal install --force-reinstalls "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi - -notifications: - irc: - channels: - - "irc.freenode.org#haskell-lens" - skip_join: true - template: - - "\x0313heaps\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,48 @@ +0.4.1 [2024.12.04] +------------------ +* Drop support for pre-8.0 versions of GHC. + +0.4 [2021.02.17] +---------------- +* `heaps` now always exports a `null` function that is specialized to `Heap`, + i.e., + + ```haskell + null :: Heap a -> Bool + ``` + + Previously, this specialized versions of `null` was only exported with GHC + 7.8 or older, and for more recent GHCs, the `Data.Foldable` version was + exported instead. The exported API is now uniform across all supported + versions of GHC. +* Export `adjustMin`. + +0.3.6.1 [2019.02.05] +-------------------- +* Change to `build-type: Simple`, and drop the `doctests` test suite. This was + done in an effort to make `heaps`' dependency footprint as minimal as + possible, since `heaps` is used to bootstrap `shake`. +* Fix the Haddocks for `span`. + +0.3.6 [2018.01.18] +------------------ +* Add `Semigroup` instance for `Heap`. + +0.3.5 +----- +* Support `doctest-0.12` + +0.3.4.1 +------- +* Fix a typo in the `doctests` for `mapMonotonic` + +0.3.4 +----- +* Add `Bifunctor Entry` instance +* Revamp `Setup.hs` to use `cabal-doctest`. This makes it build + with `Cabal-2.0`, and makes the `doctest`s work with `cabal new-build` and + sandboxes. + 0.3.3 ----- * Remove redundant constraints diff --git a/HLint.hs b/HLint.hs deleted file mode 100644 --- a/HLint.hs +++ /dev/null @@ -1,1 +0,0 @@ -ignore "Use infix" diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,7 +1,7 @@ heaps ====== -[![Hackage](https://img.shields.io/hackage/v/heaps.svg)](https://hackage.haskell.org/package/heaps) [![Build Status](https://secure.travis-ci.org/ekmett/heaps.png?branch=master)](http://travis-ci.org/ekmett/heaps) +[![Hackage](https://img.shields.io/hackage/v/heaps.svg)](https://hackage.haskell.org/package/heaps) [![Build Status](https://github.com/ekmett/heaps/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/heaps/actions?query=workflow%3AHaskell-CI) This package provides Brodal/Okasaki heaps. These are asymptotically optimal purely functional heaps. diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,7 +0,0 @@ -#!/usr/bin/runhaskell -> module Main (main) where - -> import Distribution.Simple - -> main :: IO () -> main = defaultMain diff --git a/heaps.cabal b/heaps.cabal --- a/heaps.cabal +++ b/heaps.cabal @@ -1,5 +1,5 @@ name: heaps -version: 0.3.3 +version: 0.4.1 license: BSD3 license-file: LICENSE author: Edward A. Kmett @@ -11,10 +11,26 @@ synopsis: Asymptotically optimal Brodal/Okasaki heaps. description: Asymptotically optimal Brodal\/Okasaki bootstrapped skew-binomial heaps from the paper , extended with a 'Foldable' interface. copyright: (c) 2010-2015 Edward A. Kmett -tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.0.20150307 +tested-with: GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.4 + , GHC == 9.0.2 + , GHC == 9.2.8 + , GHC == 9.4.8 + , GHC == 9.6.6 + , GHC == 9.8.4 + , GHC == 9.10.1 + , GHC == 9.12.1 build-type: Simple -cabal-version: >=1.8 -extra-source-files: HLint.hs .gitignore .travis.yml CHANGELOG.markdown README.markdown +cabal-version: >=1.10 +extra-source-files: + .gitignore + .hlint.yaml + CHANGELOG.markdown + README.markdown source-repository head type: git @@ -23,18 +39,7 @@ library exposed-modules: Data.Heap build-depends: - base >= 4 && < 6 + base >= 4.9 && < 6 hs-source-dirs: src - ghc-options: -O2 - --- Verify the results of the examples -test-suite doctests - type: exitcode-stdio-1.0 - main-is: doctests.hs - build-depends: - base, - directory >= 1.0 && < 1.3, - doctest >= 0.9 && <= 0.10, - filepath - ghc-options: -Wall - hs-source-dirs: tests + ghc-options: -O2 -Wall + default-language: Haskell2010 diff --git a/src/Data/Heap.hs b/src/Data/Heap.hs --- a/src/Data/Heap.hs +++ b/src/Data/Heap.hs @@ -1,8 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} -#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE RoleAnnotations #-} -#endif ----------------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2010-2015 @@ -32,9 +30,9 @@ module Data.Heap ( -- * Heap Type - Heap -- instance Eq,Ord,Show,Read,Data,Typeable + Heap -- instance Eq,Ord,Show,Read,Data -- * Entry type - , Entry(..) -- instance Eq,Ord,Show,Read,Data,Typeable + , Entry(..) -- instance Eq,Ord,Show,Read,Data -- * Basic functions , empty -- O(1) :: Heap a , null -- O(1) :: Heap a -> Bool @@ -43,6 +41,7 @@ , insert -- O(1) :: Ord a => a -> Heap a -> Heap a , minimum -- O(1) (/partial/) :: Ord a => Heap a -> a , deleteMin -- O(log n) :: Heap a -> Heap a + , adjustMin -- O(log n) :: (a -> a) -> Heap a -> Heap a , union -- O(1) :: Heap a -> Heap a -> Heap a , uncons, viewMin -- O(1)\/O(log n) :: Heap a -> Maybe (a, Heap a) -- * Transformations @@ -81,26 +80,38 @@ ( map , span, dropWhile, takeWhile, break, filter, take, drop, splitAt , foldr, minimum, replicate, mapM - , concatMap -#if __GLASGOW_HASKELL__ < 710 - , null -#else + , concatMap, null , traverse -#endif ) -import qualified Data.List as L -import Control.Applicative (Applicative(pure)) import Control.Monad (liftM) -import Data.Monoid (Monoid(mappend, mempty)) -import Data.Foldable hiding (minimum, concatMap) -import Data.Function (on) +import Data.Bifunctor import Data.Data (DataType, Constr, mkConstr, mkDataType, Fixity(Prefix), Data(..), constrIndex) -import Data.Typeable (Typeable) +import qualified Data.Foldable as F +import Data.Function (on) +import qualified Data.List as L +import qualified Data.Traversable as T import Text.Read -import Text.Show -import qualified Data.Traversable as Traversable -import Data.Traversable (Traversable) +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup (Semigroup(..)) +#endif + +-- $setup +-- >>> let break = Data.Heap.break +-- >>> let concatMap = Data.Heap.concatMap +-- >>> let dropWhile = Data.Heap.dropWhile +-- >>> let filter = Data.Heap.filter +-- >>> let minimum = Data.Heap.minimum +-- >>> let null = Data.Heap.null +-- >>> let span = Data.Heap.span +-- >>> let take = Data.Heap.take +-- >>> let takeWhile = Data.Heap.takeWhile +-- +-- -- GHC 7.0 and 7.2 will default the `Ord` constraints to () in the types of +-- -- the following functions unless we give them explicit type signatures. +-- >>> let { map :: Ord b => (a -> b) -> Heap a -> Heap b; map = Data.Heap.map } +-- >>> let { replicate :: Ord a => a -> Int -> Heap a ; replicate = Data.Heap.replicate } + -- 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') @@ -109,17 +120,13 @@ -- | A min-heap of values of type @a@. data Heap a = Empty - | Heap {-# UNPACK #-} !Int (a -> a -> Bool) {-# UNPACK #-} !(Tree a) - deriving Typeable - -#if __GLASGOW_HASKELL__ >= 707 + | Heap {-# UNPACK #-} !Int (a -> a -> Bool) !(Tree a) type role Heap nominal -#endif instance Show a => Show (Heap a) where showsPrec _ Empty = showString "fromList []" showsPrec d (Heap _ _ t) = showParen (d > 10) $ - showString "fromList " . showsPrec 11 (toList t) + showString "fromList " . showsPrec 11 (F.toList t) instance (Ord a, Read a) => Read (Heap a) where readPrec = parens $ prec 10 $ do @@ -144,7 +151,7 @@ Empty == Empty = True Empty == Heap{} = False Heap{} == Empty = False - a@(Heap s1 leq _) == b@(Heap s2 _ _) = s1 == s2 && go leq (toList a) (toList b) + a@(Heap s1 leq _) == b@(Heap s2 _ _) = s1 == s2 && go leq (F.toList a) (F.toList b) where go f (x:xs) (y:ys) = f x y && f y x && go f xs ys go _ [] [] = True @@ -154,7 +161,7 @@ Empty `compare` Empty = EQ Empty `compare` Heap{} = LT Heap{} `compare` Empty = GT - a@(Heap _ leq _) `compare` b = go leq (toList a) (toList b) + a@(Heap _ leq _) `compare` b = go leq (F.toList a) (F.toList b) where go f (x:xs) (y:ys) = if f x y @@ -162,9 +169,9 @@ then go f xs ys else LT else GT - go f [] [] = EQ - go f [] (_:_) = LT - go f (_:_) [] = GT + go _ [] [] = EQ + go _ [] (_:_) = LT + go _ (_:_) [] = GT @@ -289,7 +296,7 @@ (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) + f3 = F.foldr (skewInsert leq) f2 (trees zs) {-# INLINE deleteMin #-} -- | /O(log n)/. Adjust the minimum key in the heap and return the resulting heap. @@ -316,12 +323,13 @@ rightZ :: ForestZipper a -> ForestZipper a rightZ (path, x `Cons` xs) = (x `Cons` path, xs) +rightZ _ = error "Heap.rightZ: empty zipper" {-# INLINE rightZ #-} -adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a -adjustZ f (path, x `Cons` xs) = (path, f x `Cons` xs) -adjustZ _ z = z -{-# INLINE adjustZ #-} +-- adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a +-- adjustZ f (path, x `Cons` xs) = (path, f x `Cons` xs) +-- adjustZ _ z = z +-- {-# INLINE adjustZ #-} rezip :: ForestZipper a -> Forest a rezip (Nil, xs) = xs @@ -349,7 +357,10 @@ | leq a a' = n | otherwise = Node r a' (rezip (left, heapify leq (Node r' a as') `Cons` right)) where - (left, Node r' a' as' `Cons` right) = minZ leq as + -- (left, Node r' a' as' `Cons` right) = minZ leq as + (left, r', a', as', right) = case minZ leq as of + (left', Node r'' a'' as'' `Cons` right') -> (left', r'', a'', as'', right') + _ -> error "Heap.heapify: empty zipper" -- | /O(n)/. Build a heap from a list of values. @@ -362,23 +373,29 @@ -- >>> size (fromList [1,5,3]) -- 3 fromList :: Ord a => [a] -> Heap a -fromList = foldr insert mempty +fromList = F.foldr insert mempty {-# INLINE fromList #-} fromListWith :: (a -> a -> Bool) -> [a] -> Heap a -fromListWith f = foldr (insertWith f) mempty +fromListWith f = F.foldr (insertWith f) mempty {-# INLINE fromListWith #-} -- | /O(n log n)/. Perform a heap sort sort :: Ord a => [a] -> [a] -sort = toList . fromList +sort = F.toList . fromList {-# INLINE sort #-} +instance Semigroup (Heap a) where + (<>) = union + {-# INLINE (<>) #-} + instance Monoid (Heap a) where mempty = empty {-# INLINE mempty #-} +#if !(MIN_VERSION_base(4,11,0)) mappend = union {-# INLINE mappend #-} +#endif -- | /O(n)/. Returns the elements in the heap in some arbitrary, very likely unsorted, order. -- @@ -388,18 +405,14 @@ -- @'fromList' '.' 'toUnsortedList' ≡ 'id'@ toUnsortedList :: Heap a -> [a] toUnsortedList Empty = [] -toUnsortedList (Heap _ _ t) = foldMap return t +toUnsortedList (Heap _ _ t) = F.foldMap return t {-# INLINE toUnsortedList #-} instance Foldable Heap where foldMap _ Empty = mempty - foldMap f l@(Heap _ _ t) = f (root t) `mappend` foldMap f (deleteMin l) -#if __GLASGOW_HASKELL__ >= 710 - null Empty = True - null _ = False - + foldMap f l@(Heap _ _ t) = f (root t) `mappend` F.foldMap f (deleteMin l) + null = null length = size -#else -- | /O(1)/. Is the heap empty? -- @@ -413,8 +426,6 @@ null _ = False {-# INLINE null #-} -#endif - -- | /O(1)/. The number of elements in the heap. -- -- >>> size empty @@ -434,15 +445,15 @@ -- fromList [-3,-1,-2] map :: Ord b => (a -> b) -> Heap a -> Heap b map _ Empty = Empty -map f (Heap _ _ t) = foldMap (singleton . f) t +map f (Heap _ _ t) = F.foldMap (singleton . f) t {-# INLINE map #-} -- | /O(n)/. Map a monotone increasing function over the heap. -- Provides a better constant factor for performance than 'map', but no checking is performed that the function provided is monotone increasing. Misuse of this function can cause a Heap to violate the heap property. -- --- >>> map (+1) (fromList [1,2,3]) +-- >>> mapMonotonic (+1) (fromList [1,2,3]) -- fromList [2,3,4] --- >>> map (*2) (fromList [1,2,3]) +-- >>> mapMonotonic (*2) (fromList [1,2,3]) -- fromList [2,4,6] mapMonotonic :: Ord b => (a -> b) -> Heap a -> Heap b mapMonotonic _ Empty = Empty @@ -461,7 +472,7 @@ -- fromList [] filter :: (a -> Bool) -> Heap a -> Heap a filter _ Empty = Empty -filter p (Heap _ leq t) = foldMap f t +filter p (Heap _ leq t) = F.foldMap f t where f x | p x = singletonWith leq x | otherwise = Empty @@ -473,7 +484,7 @@ -- (fromList "b",fromList "a") partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a) partition _ Empty = (Empty, Empty) -partition p (Heap _ leq t) = foldMap f t +partition p (Heap _ leq t) = F.foldMap f t where f x | p x = (singletonWith leq x, mempty) | otherwise = (mempty, singletonWith leq x) @@ -484,8 +495,8 @@ -- >>> split 'h' (fromList "hello") -- (fromList "e",fromList "h",fromList "llo") split :: a -> Heap a -> (Heap a, Heap a, Heap a) -split a Empty = (Empty, Empty, Empty) -split a (Heap s leq t) = foldMap f t +split _ Empty = (Empty, Empty, Empty) +split a (Heap _ leq t) = F.foldMap f t where f x = if leq x a then if leq a x @@ -531,7 +542,7 @@ -- >>> span (\x -> x `mod` 4 == 0) (fromList [4,8,12,14,16]) -- (fromList [4,8,12],fromList [14,16]) -- --- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile p xs)@ +-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ span :: (a -> Bool) -> Heap a -> (Heap a, Heap a) span = splitWithList . L.span @@ -573,7 +584,7 @@ -- fromList [1,4,5,2] concatMap :: (a -> Heap b) -> Heap a -> Heap b concatMap _ Empty = Empty -concatMap f h@(Heap _ _ t) = foldMap f t +concatMap f (Heap _ _ t) = F.foldMap f t {-# INLINE concatMap #-} -- | /O(n log n)/. Group a heap into a heap of heaps, by unioning together duplicates. @@ -587,7 +598,7 @@ -- | /O(n log n)/. Group using a user supplied function. groupBy :: (a -> a -> Bool) -> Heap a -> Heap (Heap a) -groupBy f Empty = Empty +groupBy _ Empty = Empty groupBy f h@(Heap _ leq t) = insert (insertWith leq x ys) (groupBy f zs) where x = root t @@ -599,7 +610,7 @@ intersect :: Heap a -> Heap a -> Heap a intersect Empty _ = Empty intersect _ Empty = Empty -intersect a@(Heap _ leq _) b = go leq (toList a) (toList b) +intersect a@(Heap _ leq _) b = go leq (F.toList a) (F.toList b) where go leq' xxs@(x:xs) yys@(y:ys) = if leq' x y @@ -615,7 +626,7 @@ intersectWith :: Ord b => (a -> a -> b) -> Heap a -> Heap a -> Heap b intersectWith _ Empty _ = Empty intersectWith _ _ Empty = Empty -intersectWith f a@(Heap _ leq _) b = go leq f (toList a) (toList b) +intersectWith f a@(Heap _ leq _) b = go leq f (F.toList a) (F.toList b) where go :: Ord b => (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b go leq' f' xxs@(x:xs) yys@(y:ys) @@ -630,12 +641,12 @@ -- | /O(n log n)/. Traverse the elements of the heap in sorted order and produce a new heap using 'Applicative' side-effects. traverse :: (Applicative t, Ord b) => (a -> t b) -> Heap a -> t (Heap b) -traverse f = fmap fromList . Traversable.traverse f . toList +traverse f = fmap fromList . T.traverse f . F.toList {-# INLINE traverse #-} -- | /O(n log n)/. Traverse the elements of the heap in sorted order and produce a new heap using 'Monad'ic side-effects. mapM :: (Monad m, Ord b) => (a -> m b) -> Heap a -> m (Heap b) -mapM f = liftM fromList . Traversable.mapM f . toList +mapM f = liftM fromList . T.mapM f . F.toList {-# INLINE mapM #-} both :: (a -> b) -> (a, a) -> (b, b) @@ -647,10 +658,10 @@ { rank :: {-# UNPACK #-} !Int , root :: a , _forest :: !(Forest a) - } deriving (Show,Read,Typeable) + } deriving (Show,Read) data Forest a = !(Tree a) `Cons` !(Forest a) | Nil - deriving (Show,Read,Typeable) + deriving (Show,Read) infixr 5 `Cons` instance Functor Tree where @@ -662,11 +673,11 @@ -- 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 + foldMap f (Node _ a as) = f a `mappend` F.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 f (a `Cons` as) = F.foldMap f a `mappend` F.foldMap f as foldMap _ Nil = mempty link :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a @@ -737,12 +748,12 @@ withList :: ([a] -> [a]) -> Heap a -> Heap a withList _ Empty = Empty -withList f hp@(Heap _ leq _) = fromListWith leq (f (toList hp)) +withList f hp@(Heap _ leq _) = fromListWith leq (f (F.toList hp)) {-# INLINE withList #-} splitWithList :: ([a] -> ([a],[a])) -> Heap a -> (Heap a, Heap a) splitWithList _ Empty = (Empty, Empty) -splitWithList f hp@(Heap _ leq _) = both (fromListWith leq) (f (toList hp)) +splitWithList f hp@(Heap _ leq _) = both (fromListWith leq) (f (F.toList hp)) {-# INLINE splitWithList #-} -- | Explicit priority/payload tuples. Useful to build a priority queue using @@ -754,11 +765,14 @@ -- ==> 'foldMap' 'payload' myHeap ≡ "HelloWorld!" -- @ data Entry p a = Entry { priority :: p, payload :: a } - deriving (Read,Show,Data,Typeable) + deriving (Read,Show,Data) instance Functor (Entry p) where fmap f (Entry p a) = Entry p (f a) {-# INLINE fmap #-} + +instance Bifunctor Entry where + bimap f g (Entry p a) = Entry (f p) (g a) instance Foldable (Entry p) where foldMap f (Entry _ a) = f a diff --git a/tests/doctests.hs b/tests/doctests.hs deleted file mode 100644 --- a/tests/doctests.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Main where - -import Test.DocTest -import System.Directory -import System.FilePath -import Control.Applicative -import Control.Monad -import Data.List - -main :: IO () -main = getSources >>= \sources -> doctest $ - "-isrc" - : "-idist/build/autogen" - : "-optP-include" - : "-optPdist/build/autogen/cabal_macros.h" - : sources - -getSources :: IO [FilePath] -getSources = filter (isSuffixOf ".hs") <$> go "src" - where - go dir = do - (dirs, files) <- getFilesAndDirectories dir - (files ++) . concat <$> mapM go dirs - -getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) -getFilesAndDirectories dir = do - c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir - (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c