monoid-subclasses 0.4.1.1 → 0.4.1.2

raw patch · 2 files changed

+2/−305 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Monoid/Instances/Markup.hs +0/−302
• monoid-subclasses.cabal +2/−3

@@ -1,302 +0,0 @@-{- -    Copyright 2013-2015 Mario Blazevic--    License: BSD3 (see BSD3-LICENSE.txt file)--}---- | This module defines monoid transformers that add support for markup over the base monoid type--- --{-# LANGUAGE Haskell2010 #-}--module Data.Monoid.Instances.Markup (-   TagSoup, soupLeaf, soupTag-   )-where--import Control.Applicative (Applicative(..))-import qualified Data.Foldable as Foldable-import Data.Functor -- ((<$>))-import qualified Data.List as List-import Data.Sequence (Seq, ViewL((:<)), ViewR((:>)), (<|), (|>))-import qualified Data.Sequence as Seq-import Data.Tree (Forest)-import qualified Data.Tree as Tree-import Data.String (IsString(..))-import Data.Monoid -- (Monoid(..))-import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..),-                                 LeftCancellativeMonoid, RightCancellativeMonoid,-                                 LeftGCDMonoid(..), RightGCDMonoid(..))-import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)-import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid)-import Data.Monoid.Textual (TextualMonoid(..))-import qualified Data.Monoid.Factorial as Factorial-import qualified Data.Monoid.Textual as Textual--import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap,-                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)--newtype TagSoup a b = TagSoup (Seq (Either a b)) deriving (Eq)--instance Monoid b => Monoid (TagSoup a b) where-   mempty = TagSoup mempty-   TagSoup s1 `mappend` TagSoup s2-      | s1' :> Right t1 <- Seq.viewr s1, Right t2 :< s2' <- Seq.viewl s2 = TagSoup ((s1' |> Right (t1 <> t2)) <> s2')-      | otherwise = TagSoup (s1 <> s2)--instance (Eq a, Eq b, MonoidNull b, LeftReductiveMonoid b) => LeftReductiveMonoid (TagSoup a b) where-   stripPrefix (TagSoup s1) (TagSoup s2)-      | s1' :> Right t1 <- Seq.viewr s1 =-           case stripPrefix s1' s2-           of Just s2' | Right t2 :< s2'' <- Seq.viewl s2', Just t2' <- stripPrefix t1 t2 -> Just (TagSoup $ consL Right t2' s2'')-              _ -> Nothing-      | otherwise = TagSoup <$> stripPrefix s1 s2--instance (Eq a, Eq b, MonoidNull b, RightReductiveMonoid b) => RightReductiveMonoid (TagSoup a b) where-   stripSuffix (TagSoup s1) (TagSoup s2)-      | Right t1 :< s1' <- Seq.viewl s1 =-           case stripSuffix s1' s2-           of Just s2' | s2'' :> Right t2 <- Seq.viewr s2', Just t2' <- stripSuffix t1 t2 -> Just (TagSoup $ consR Right s2'' t2')-              _ -> Nothing-      | otherwise = TagSoup <$> stripSuffix s1 s2--instance (Eq a, Eq b, MonoidNull b, LeftCancellativeMonoid b) => LeftCancellativeMonoid (TagSoup a b)-instance (Eq a, Eq b, MonoidNull b, RightCancellativeMonoid b) => RightCancellativeMonoid (TagSoup a b)--instance (Eq a, Eq b, MonoidNull b, LeftGCDMonoid b) => LeftGCDMonoid (TagSoup a b) where-   stripCommonPrefix (TagSoup s1) (TagSoup s2)-      | Right t1 :< s1'' <- Seq.viewl s1', Right t2 :< s2'' <- Seq.viewl s2', (tp, t1', t2') <- stripCommonPrefix t1 t2 =-           (TagSoup $ consR Right prefix tp, TagSoup $ consL Right t1' s1'', TagSoup $ consL Right t2' s2'')-      | otherwise = (TagSoup prefix, TagSoup s1', TagSoup s2')-     where (prefix, s1', s2') = stripCommonPrefix s1 s2--instance (Eq a, Eq b, MonoidNull b, RightGCDMonoid b) => RightGCDMonoid (TagSoup a b) where-   stripCommonSuffix (TagSoup s1) (TagSoup s2)-      | s1'' :> Right t1 <- Seq.viewr s1', s2'' :> Right t2 <- Seq.viewr s2', (t1', t2', ts) <- stripCommonSuffix t1 t2 =-           (TagSoup $ consR Right s1'' t1', TagSoup $ consR Right s2'' t2', TagSoup $ consR Right suffix ts)-      | otherwise = (TagSoup s1', TagSoup s2', TagSoup suffix)-     where (s1', s2', suffix) = stripCommonSuffix s1 s2--instance Monoid b => MonoidNull (TagSoup a b) where-   null (TagSoup s) = null s--instance Monoid b => PositiveMonoid (TagSoup a b)--instance FactorialMonoid b => FactorialMonoid (TagSoup a b) where-   factors (TagSoup s) = List.concatMap (either (\t-> [soupTag t]) (fmap nonNullSoupLeaf . factors)) (Foldable.toList s)-   splitPrimePrefix (TagSoup s) =-      case Seq.viewl s-      of Seq.EmptyL -> Nothing-         p@Left{} :< s' -> Just (TagSoup $ Seq.singleton p, TagSoup s')-         Right t :< s' | ~(Just (p, t')) <- splitPrimePrefix t -> Just (nonNullSoupLeaf p, TagSoup $ consL Right t' s')-   primePrefix ts@(TagSoup s) =-      case Seq.viewl s-      of Seq.EmptyL -> ts-         p@Left{} :< _ -> TagSoup (Seq.singleton p)-         Right t :< _ -> nonNullSoupLeaf (primePrefix t)-   splitPrimeSuffix (TagSoup s) =-      case Seq.viewr s-      of Seq.EmptyR -> Nothing-         s' :> p@Left{} -> Just (TagSoup s', TagSoup $ Seq.singleton p)-         s' :> Right t | ~(Just (t', p)) <- splitPrimeSuffix t -> Just (TagSoup $ consR Right s' t', nonNullSoupLeaf p)-   primeSuffix ts@(TagSoup s) =-      case Seq.viewr s-      of Seq.EmptyR -> ts-         _ :> p@Left{} -> TagSoup (Seq.singleton p)-         _ :> Right t -> nonNullSoupLeaf (primeSuffix t)-   foldl f a0 (TagSoup s) = Foldable.foldl g a0 s-      where g a p@Left{} = f a (TagSoup $ Seq.singleton p)-            g a (Right t) = Factorial.foldl (\a'-> f a' . nonNullSoupLeaf) a t-   foldl' f a0 (TagSoup s) = Foldable.foldl' g a0 s-      where g a p@Left{} = f a (TagSoup $ Seq.singleton p)-            g a (Right t) = Factorial.foldl' (\a'-> f a' . nonNullSoupLeaf) a t-   foldr f a0 (TagSoup s) = Foldable.foldr g a0 s-      where g p@Left{} a = f (TagSoup $ Seq.singleton p) a-            g (Right t) a = Factorial.foldr (f . nonNullSoupLeaf) a t-   length (TagSoup s) = getSum $ Foldable.foldMap (either (const $ Sum 1) (Sum . length)) s-   foldMap f (TagSoup s) = Foldable.foldMap (either (f . soupTag) (Factorial.foldMap $ f . nonNullSoupLeaf)) s-   span p (TagSoup x) =-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty)-         xp@Left{} :< xs | p (TagSoup $ Seq.singleton xp) -> (TagSoup (xp <| xsp), xss)-                         | otherwise -> (mempty, TagSoup x)-            where (TagSoup xsp, xss) = Factorial.span p (TagSoup xs)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss)-                        | null xpp -> (mempty, TagSoup x)-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs))-            where (xpp, xps) = Factorial.span (p . nonNullSoupLeaf) xp-                  (TagSoup xsp, xss) = Factorial.span p (TagSoup xs)-   spanMaybe s0 f (TagSoup x) =-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty, s0)-         xp@Left{} :< xs -> case f s0 (TagSoup $ Seq.singleton xp)-                            of Just s' -> let (TagSoup xsp, xss, s'') = Factorial.spanMaybe s' f (TagSoup xs)-                                          in (TagSoup (xp <| xsp), xss, s'')-                               Nothing -> (mempty, TagSoup x, s0)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss, s'')-                        | null xpp -> (mempty, TagSoup x, s')-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs), s')-            where (xpp, xps, s') = Factorial.spanMaybe s0 (\s-> f s . nonNullSoupLeaf) xp-                  (TagSoup xsp, xss, s'') = Factorial.spanMaybe s' f (TagSoup xs)-   spanMaybe' s0 f (TagSoup x) =-      seq s0 $-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty, s0)-         xp@Left{} :< xs -> case f s0 (TagSoup $ Seq.singleton xp)-                            of Just s' -> let (TagSoup xsp, xss, s'') = Factorial.spanMaybe' s' f (TagSoup xs)-                                          in (TagSoup (xp <| xsp), xss, s'')-                               Nothing -> (mempty, TagSoup x, s0)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss, s'')-                        | null xpp -> (mempty, TagSoup x, s')-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs), s')-            where (xpp, xps, s') = Factorial.spanMaybe' s0 (\s-> f s . nonNullSoupLeaf) xp-                  (TagSoup xsp, xss, s'') = Factorial.spanMaybe' s' f (TagSoup xs)-   split p (TagSoup x) = Foldable.foldr splitNext [mempty] x-      where splitNext t@Left{} ~l@(xp:xs)-               | p (TagSoup $ Seq.singleton t) = mempty:l-               | otherwise = (TagSoup (Seq.singleton t) <> xp):xs-            splitNext (Right t) ~(xp:xs) =-               let ts = soupLeaf <$> Factorial.split (p . nonNullSoupLeaf) t-               in if null xp-                  then ts ++ xs-                  else init ts ++ (last ts <> xp):xs-   splitAt 0 s = (mempty, s)-   splitAt n (TagSoup x) =-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty)-         xp@Left{} :< xs -> (TagSoup (xp <| xsp), xss)-           where (TagSoup xsp, xss) = splitAt (n - 1) (TagSoup xs)-         Right xp :< xs | k < n -> (TagSoup (Right xp <| xsp), xss)-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup $ consL Right xps xs)-            where k = length xp-                  (TagSoup xsp, xss) = splitAt (n - k) (TagSoup xs)-                  (xpp, xps) = splitAt n xp-   reverse (TagSoup x) = TagSoup (either Left (Right . reverse) <$> reverse x)--instance StableFactorialMonoid b => StableFactorialMonoid (TagSoup a b)--instance (IsString b, MonoidNull b) => IsString (TagSoup a b) where-   fromString s = soupLeaf (fromString s)--instance (Eq a, Eq b, TextualMonoid b) => TextualMonoid (TagSoup a b) where-   splitCharacterPrefix (TagSoup s) =-      case Seq.viewl s-      of Right t :< s' | Just (c, t') <- splitCharacterPrefix t -> Just (c, TagSoup $ consL Right t' s')-         _ -> Nothing-   characterPrefix (TagSoup s) =-      case Seq.viewl s-      of Right t :< _ -> characterPrefix t-         _ -> Nothing-   fromText = soupLeaf . fromText-   singleton = nonNullSoupLeaf . singleton-   map f (TagSoup x) = TagSoup (fmap (either Left $ Right . map f) x)-   any p (TagSoup x) = Foldable.any (either (const False) $ any p) x-   all p (TagSoup x) = Foldable.all (either (const False) $ all p) x-   foldl ft fc a0 (TagSoup x) = Foldable.foldl g a0 x-      where g a (Right t) = Textual.foldl (\a1-> ft a1 . nonNullSoupLeaf) fc a t-            g a t@Left{} = ft a (TagSoup $ Seq.singleton t)-   foldl' ft fc a0 (TagSoup x) = Foldable.foldl' g a0 x-      where g a t@Left{} = a `seq` ft a (TagSoup $ Seq.singleton t)-            g a (Right t) = Textual.foldl' (\a1-> ft a1 . nonNullSoupLeaf) fc a t-   foldr ft fc a0 (TagSoup x) = Foldable.foldr g a0 x-      where g t@Left{} a = ft (TagSoup $ Seq.singleton t) a-            g (Right t) a = Textual.foldr (ft . nonNullSoupLeaf) fc a t-   toString ft (TagSoup x) = List.concatMap (either (ft . soupTag) (toString $ ft . nonNullSoupLeaf)) (Foldable.toList x)-   span pt pc (TagSoup x) =-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty)-         xp@Left{} :< xs | pt (TagSoup $ Seq.singleton xp) -> (TagSoup (xp <| xsp), xss)-                         | otherwise -> (mempty, TagSoup x)-            where (TagSoup xsp, xss) = Textual.span pt pc (TagSoup xs)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss)-                        | null xpp -> (mempty, TagSoup x)-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs))-            where (xpp, xps) = Textual.span (pt . nonNullSoupLeaf) pc xp-                  (TagSoup xsp, xss) = Textual.span pt pc (TagSoup xs)-   span_ bt pc (TagSoup x) =-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty)-         xp@Left{} :< xs -> if bt then (TagSoup (xp <| xsp), xss) else (mempty, TagSoup x)-            where (TagSoup xsp, xss) = Textual.span_ bt pc (TagSoup xs)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss)-                        | null xpp -> (mempty, TagSoup x)-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs))-            where (xpp, xps) = Textual.span_ bt pc xp-                  (TagSoup xsp, xss) = Textual.span_ bt pc (TagSoup xs)-   break pt pc = Textual.span (not . pt) (not . pc)-   takeWhile_ bt pc = fst . span_ bt pc-   dropWhile_ bt pc = snd . span_ bt pc-   break_ bt pc = span_ (not bt) (not . pc)-   spanMaybe s0 ft fc (TagSoup x) =-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty, s0)-         xp@Left{} :< xs | Just s' <- ft s0 (TagSoup $ Seq.singleton xp),-                           (TagSoup xsp, xss, s'') <- Textual.spanMaybe s' ft fc (TagSoup xs) -> (TagSoup (xp <| xsp), xss, s'')-                         | otherwise -> (mempty, TagSoup x, s0)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss, s'')-                        | null xpp -> (mempty, TagSoup x, s')-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs), s')-            where (xpp, xps, s') = Textual.spanMaybe s0 (\s-> ft s . nonNullSoupLeaf) fc xp-                  (TagSoup xsp, xss, s'') = Textual.spanMaybe s' ft fc (TagSoup xs)-   spanMaybe' s0 ft fc (TagSoup x) =-      seq s0 $-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty, s0)-         xp@Left{} :< xs | Just s' <- ft s0 (TagSoup $ Seq.singleton xp),-                           (TagSoup xsp, xss, s'') <- Textual.spanMaybe' s' ft fc (TagSoup xs) -> (TagSoup (xp <| xsp), xss, s'')-                         | otherwise -> (mempty, TagSoup x, s0)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss, s'')-                        | null xpp -> (mempty, TagSoup x, s')-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs), s')-            where (xpp, xps, s') = Textual.spanMaybe' s0 (\s-> ft s . nonNullSoupLeaf) fc xp-                  (TagSoup xsp, xss, s'') = Textual.spanMaybe' s' ft fc (TagSoup xs)-   spanMaybe_ s0 fc (TagSoup x) =-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty, s0)-         xp@Left{} :< xs | (TagSoup xsp, xss, s') <- Textual.spanMaybe_ s0 fc (TagSoup xs) -> (TagSoup (xp <| xsp), xss, s')-                         | otherwise -> (mempty, TagSoup x, s0)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss, s'')-                        | null xpp -> (mempty, TagSoup x, s')-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs), s')-            where (xpp, xps, s') = Textual.spanMaybe_ s0 fc xp-                  (TagSoup xsp, xss, s'') = Textual.spanMaybe_ s' fc (TagSoup xs)-   spanMaybe_' s0 fc (TagSoup x) =-      seq s0 $-      case Seq.viewl x-      of Seq.EmptyL -> (mempty, mempty, s0)-         xp@Left{} :< xs | (TagSoup xsp, xss, s') <- Textual.spanMaybe_' s0 fc (TagSoup xs) -> (TagSoup (xp <| xsp), xss, s')-                         | otherwise -> (mempty, TagSoup x, s0)-         Right xp :< xs | null xps -> (TagSoup (Right xp <| xsp), xss, s'')-                        | null xpp -> (mempty, TagSoup x, s')-                        | otherwise -> (nonNullSoupLeaf xpp, TagSoup (Right xps <| xs), s')-            where (xpp, xps, s') = Textual.spanMaybe_' s0 fc xp-                  (TagSoup xsp, xss, s'') = Textual.spanMaybe_' s' fc (TagSoup xs)-   split p (TagSoup x) = Foldable.foldr splitNext [mempty] x-      where splitNext tag@Left{} ~(xp:xs) = (TagSoup (Seq.singleton tag) <> xp):xs-            splitNext (Right t) ~(xp:xs) =-               let ts = soupLeaf <$> Textual.split p t-               in if null xp-                  then ts ++ xs-                  else init ts ++ (last ts <> xp):xs-   find p (TagSoup x) = getFirst $ Foldable.foldMap (First . either (const Nothing) (find p)) x-   elem c (TagSoup x) = Foldable.any (either (const False) $ Textual.elem c) x--soupLeaf :: MonoidNull b => b -> TagSoup a b-soupLeaf l | null l = TagSoup Seq.empty-           | otherwise = TagSoup (Seq.singleton $ Right l)--soupTag :: a -> TagSoup a b-soupTag = TagSoup . Seq.singleton . Left---- Helper functions--nonNullSoupLeaf :: b -> TagSoup a b-nonNullSoupLeaf = TagSoup . Seq.singleton . Right--consL :: MonoidNull a => (a -> b) -> a -> Seq b -> Seq b-consL f t s | null t = s-            | otherwise = f t <| s--consR :: MonoidNull a => (a -> b) -> Seq b -> a -> Seq b-consR f s t | null t = s-            | otherwise = s |> f t

@@ -1,5 +1,5 @@ Name:                monoid-subclasses-Version:             0.4.1.1+Version:             0.4.1.2 Cabal-Version:       >= 1.10 Build-Type:          Simple Synopsis:            Subclasses of Monoid@@ -23,8 +23,7 @@ Library   Exposed-Modules:   Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null, Data.Monoid.Textual,                      Data.Monoid.Instances.ByteString.UTF8, Data.Monoid.Instances.Concat,-                     Data.Monoid.Instances.Markup, Data.Monoid.Instances.Measured,-                     Data.Monoid.Instances.Positioned, Data.Monoid.Instances.Stateful+                     Data.Monoid.Instances.Measured, Data.Monoid.Instances.Positioned, Data.Monoid.Instances.Stateful   Build-Depends:     base >= 4.5 && < 5,                      bytestring >= 0.9 && < 1.0, containers >= 0.5.2.0 && < 0.6, text >= 0.11 && < 1.3,                      primes == 0.2.*, vector >= 0.9 && < 0.12