fmlist 0.9.4 → 0.9.5

raw patch · 2 files changed

+141/−20 lines, 2 filesdep −failPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: fail

API changes (from Hackage documentation)

Files

• Data/FMList.hs +126/−16
• fmlist.cabal +15/−4

@@ -28,6 +28,9 @@ ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}   module Data.FMList (@@ -40,6 +43,8 @@   , singleton   , cons   , snoc+  , viewl+  , viewr   , pair   , append @@ -63,6 +68,7 @@   , foldMapA    , filter+  , filterM   , take   , drop   , takeWhile@@ -78,25 +84,30 @@   , unfold   , unfoldr +  -- * Transforming+  , mapMaybe+  , wither   ) where  import Prelude-  ( (.), ($), ($!), flip, const, error+  ( (.), ($), ($!), flip, const, error, otherwise   , Either(..), either   , Bool(..), (&&)   , Ord(..), Num(..), Int   , Show(..), String, (++)   )+import qualified Prelude as P import Data.Maybe (Maybe(..), maybe, fromMaybe, isNothing) import Data.Monoid (Monoid, mempty, mappend, Dual(..), First(..), Last(..), Sum(..))  #if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup((<>)))+import Data.Semigroup (Semigroup)+import qualified Data.Semigroup as S #endif  import Data.Foldable (Foldable, foldMap, foldr, toList) import Data.Traversable (Traversable, traverse)-import Control.Monad+import Control.Monad hiding (filterM) import Control.Monad.Fail as MF import Control.Applicative @@ -104,6 +115,21 @@ -- newtype FMList a = FM { unFM :: forall m . Monoid m => (a -> m) -> m } +infixr 6 <>++-- We define our own (<>) instead of using the one from Data.Semigroup+-- or Data.Monoid. This has two advantages:+--+-- 1. It avoids certain annoying compatibility issues in constraints.+-- 2. In the situation (sadly common in this context) where things+--    don't specialize and we actually pass a Monoid dictionary, it's+--    faster to extract mempty from that dictionary than to first+--    extract the Semigroup superclass dictionary and then extract its+--    (<>) method.+(<>) :: Monoid m => m -> m -> m+(<>) = mappend+{-# INLINE (<>) #-}+ -- | The function 'transform' transforms a list by changing -- the map function that is passed to 'foldMap'. --@@ -175,18 +201,73 @@ genericLength :: Num b => FMList a -> b genericLength l = getSum $ unFM l (const $ Sum 1) +infixl 5 :<+data ViewL a+  = EmptyL+  | a :< FMList a+  deriving (Show, Functor, Foldable, Traversable) +unviewl :: ViewL a -> FMList a+unviewl EmptyL = nil+unviewl (x :< xs) = cons x xs++#if MIN_VERSION_base(4,9,0)+instance Semigroup (ViewL a) where+  EmptyL <> v = v+  (x :< xs) <> v = x :< (xs >< unviewl v)+#endif++instance Monoid (ViewL a) where+  mempty     = EmptyL+#if !MIN_VERSION_base(4,9,0)+  EmptyL `mappend` v = v+  (x :< xs) `mappend` v = x :< (xs >< unviewl v)+#endif++infixr 5 :>+data ViewR a+  = EmptyR+  | FMList a :> a+  deriving (Show, Functor, Foldable, Traversable)++unviewr :: ViewR a -> FMList a+unviewr EmptyR = nil+unviewr (xs :> x) = xs `snoc` x++#if MIN_VERSION_base(4,9,0)+instance Semigroup (ViewR a) where+  v <> EmptyR = v+  v <> (xs :> x) = (unviewr v >< xs) :> x+#endif++instance Monoid (ViewR a) where+  mempty     = EmptyR+#if !MIN_VERSION_base(4,9,0)+  v `mappend` EmptyR = v+  v `mappend` (xs :> x) =(unviewr v >< xs) :> x+#endif++viewl :: FMList a -> ViewL a+viewl = foldMap (:< nil)++viewr :: FMList a -> ViewR a+viewr = foldMap (nil :>)+ head         :: FMList a -> a head l       = mhead l `fromMaybeOrError` "Data.FMList.head: empty list"  tail         :: FMList a -> FMList a-tail l       = if null l then error "Data.FMList.tail: empty list" else drop (1::Int) l+tail l       = case viewl l of+  EmptyL  -> error "Data.FMList.tail: empty list"+  _ :< l' -> l'  last         :: FMList a -> a last l       = getLast (unFM l (Last . Just)) `fromMaybeOrError` "Data.FMList.last: empty list"  init         :: FMList a -> FMList a-init l       = if null l then error "Data.FMList.init: empty list" else reverse . drop (1::Int) . reverse $ l+init l       = case viewr l of+  EmptyR  -> error "Data.FMList.init: empty list"+  l' :> _ -> l'  reverse      :: FMList a -> FMList a reverse l    = FM $ getDual . unFM l . (Dual .)@@ -197,7 +278,20 @@ filter       :: (a -> Bool) -> FMList a -> FMList a filter p     = transform (\f x -> if p x then f x else mempty) +mapMaybe     :: (a -> Maybe b) -> FMList a -> FMList b+mapMaybe p   = transform (\f x -> maybe mempty f (p x)) +filterM      :: Applicative m => (a -> m Bool) -> FMList a -> m (FMList a)+filterM p l  = unWrapApp $ unFM l $ \a ->+  let+    go pr+      | pr = one a+      | otherwise = nil+  in WrapApp $ fmap go (p a)++wither      :: Applicative m => (a -> m (Maybe b)) -> FMList a -> m (FMList b)+wither p l  = unWrapApp $ unFM l $ \a -> WrapApp $ fmap (maybe nil one) (p a)+ -- transform the foldMap to foldr with state. transformCS  :: (forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m) -> s -> FMList a -> FMList b transformCS t s0 l = FM $ \f -> foldr (\e r -> t f e (\a -> mappend a . r)) mempty l s0@@ -215,7 +309,7 @@ dropWhile p  = transformCS (\f e c ok -> if ok && p e then c mempty True else c (f e) False) True  zipWith      :: (a -> b -> c) -> FMList a -> FMList b -> FMList c-zipWith t    = transformCS (\f e2 c r1 -> foldr (\e1 _ -> c (f (t e1 e2)) (drop (1::Int) r1)) mempty r1)+zipWith t xs ys = fromList $ P.zipWith t (toList xs) (toList ys)  zip          :: FMList a -> FMList b -> FMList (a,b) zip          = zipWith (,)@@ -231,6 +325,8 @@  -- | 'cycle' repeats a list to create an infinite list. -- It is also accessible from the end, where @last (cycle l)@ equals @last l@.+--+-- Caution: @cycle 'empty'@ is an infinite loop. cycle        :: FMList a -> FMList a cycle l      = l >< cycle l >< l @@ -246,7 +342,9 @@ -- > fromList [10,9,8,7,6,5,4,3,2,1] -- unfoldr      :: (b -> Maybe (a, b)) -> b -> FMList a-unfoldr g    = unfold (maybe empty (\(a, b) -> Right a `pair` Left b) . g)+unfoldr g = go+  where+    go b = maybe nil (\(a, b') -> cons a (go b')) (g b)  -- | 'unfold' builds a list from a seed value. -- The function takes the seed and returns an 'FMList' of values.@@ -261,25 +359,33 @@ unfold       :: (b -> FMList (Either b a)) -> b -> FMList a unfold g     = transform (\f -> either (foldMap f . unfold g) f) . g -+-- | This is essentially the same as 'Data.Monoid.Ap'. We include it here+-- partly for compatibility with older base versions. But as discussed at the+-- local definition of '<>', it can be slightly better for performance to have+-- 'mappend' for this type defined in terms of 'mappend' for the underlying+-- 'Monoid' rather than 'S.<>' for the underlying 'Semigroup'. newtype WrapApp f m = WrapApp { unWrapApp :: f m }  #if MIN_VERSION_base(4,9,0)-instance (Applicative f, Semigroup m) => Semigroup (WrapApp f m) where-  WrapApp a <> WrapApp b = WrapApp $ (<>) <$> a <*> b-#endif+instance (Applicative f, Monoid m) => Semigroup (WrapApp f m) where+  WrapApp a <> WrapApp b = WrapApp $ liftA2 (<>) a b  instance (Applicative f, Monoid m) => Monoid (WrapApp f m) where+  mempty  = WrapApp $ pure mempty+#else+instance (Applicative f, Monoid m) => Monoid (WrapApp f m) where   mempty                          = WrapApp $ pure mempty-  mappend (WrapApp a) (WrapApp b) = WrapApp $ mappend <$> a <*> b+  mappend (WrapApp a) (WrapApp b) = WrapApp $ liftA2 mappend a b+#endif  -- | Map each element of a structure to an action, evaluate these actions from left to right, -- and concat the monoid results.-foldMapA :: (Foldable t, Applicative f, Monoid m) => (a -> f m) -> t a -> f m+foldMapA+  :: ( Foldable t, Applicative f, Monoid m)+  => (a -> f m) -> t a -> f m foldMapA f = unWrapApp . foldMap (WrapApp . f)  - instance Functor FMList where   fmap g     = transform (\f -> f . g)   a <$ l     = transform (\f -> const (f a)) l@@ -291,9 +397,8 @@   traverse f = foldMapA (fmap one . f)  instance Monad FMList where-  return     = one   m >>= g    = transform (\f -> foldMap f . g) m-  m >> k     = transform (\f -> const (foldMap f k)) m+  (>>)       = (*>)  instance MF.MonadFail FMList where   fail _ = nil@@ -303,6 +408,9 @@   gs <*> xs  = transform (\f g -> unFM xs (f . g)) gs   as <*  bs  = transform (\f a -> unFM bs (const (f a))) as   as  *> bs  = transform (\f   -> const (unFM bs f)) as+#if MIN_VERSION_base (4,10,0)+  liftA2 g xs ys = transform (\f x -> unFM ys (\y -> f (g x y))) xs+#endif  #if MIN_VERSION_base(4,9,0) instance Semigroup (FMList a) where@@ -311,7 +419,9 @@  instance Monoid (FMList a) where   mempty     = nil+#if !MIN_VERSION_base(4,9,0)   mappend    = (><)+#endif  instance MonadPlus FMList where   mzero      = nil

@@ -1,5 +1,5 @@ name:                fmlist-version:             0.9.4+version:             0.9.5 synopsis:            FoldMap lists description:   FoldMap lists are lists represented by their foldMap function.@@ -18,14 +18,25 @@ build-type:          Simple cabal-version:       >= 1.10 +tested-with:+  GHC == 9.14.1+  GHC == 9.12.4+  GHC == 9.10.3+  GHC == 9.8.4+  GHC == 9.6.7+  GHC == 9.4.8+  GHC == 9.2.8+  GHC == 9.0.2+  GHC == 8.10.7+ Library   exposed-modules:     Data.FMList   build-depends:       base >= 3 && < 5-  if impl(ghc < 8.0)-    build-depends: fail   default-language:    Haskell98 +  ghc-options:         -Wall -Wcompat + source-repository head   type:     git-  location: git://github.com/sjoerdvisscher/fmlist.git+  location: https://github.com/sjoerdvisscher/fmlist.git