{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# OPTIONS_GHC -fno-warn-unused-imports       #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Monoid.Cut
-- Copyright   :  (c) 2012-2015 diagrams-core team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- The @Cut@ monoid transformer introduces \"cut points\" such that
-- all values between any two cut points are thrown away.  That is,
--
-- > a b c | d e | f g h i | j k  ==  a b c | j k
--
-----------------------------------------------------------------------------

module Data.Monoid.Cut
       ( Cut(..), cut

       ) where

import Data.Data
import Data.Semigroup
import Data.Foldable
import Data.Traversable

infix 5 :||:

-- | A value of type @Cut m@ is either a single @m@, or a pair of
--   @m@'s separated by a divider.  The divider represents a \"cut
--   point\".
--
--   @Cut@ is similar to "Data.Monoid.Split", but split keeps only the
--   rightmost divider and accumulates all values, whereas cut always
--   keeps the leftmost and rightmost divider, coalescing them into
--   one and throwing away all the information in between.
--
--   @Split@ uses the asymmetric constructor @:|@, and @Cut@ the
--   symmetric constructor @:||:@, to emphasize the inherent asymmetry
--   of @Split@ and symmetry of @Cut@.  @Split@ keeps only the
--   rightmost split and combines everything on the left; @Cut@ keeps
--   the outermost splits and throws away everything in between.
data Cut m = Uncut m
           | m :||: m
  deriving (Cut m -> DataType
Cut m -> Constr
forall {m}. Data m => Typeable (Cut m)
forall m. Data m => Cut m -> DataType
forall m. Data m => Cut m -> Constr
forall m. Data m => (forall b. Data b => b -> b) -> Cut m -> Cut m
forall m u.
Data m =>
Int -> (forall d. Data d => d -> u) -> Cut m -> u
forall m u. Data m => (forall d. Data d => d -> u) -> Cut m -> [u]
forall m r r'.
Data m =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cut m -> r
forall m r r'.
Data m =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cut m -> r
forall m (m :: * -> *).
(Data m, Monad m) =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
forall m (m :: * -> *).
(Data m, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
forall m (c :: * -> *).
Data m =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cut m)
forall m (c :: * -> *).
Data m =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cut m -> c (Cut m)
forall m (t :: * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Cut m))
forall m (t :: * -> * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Cut m))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cut m)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cut m -> c (Cut m)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Cut m))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
$cgmapMo :: forall m (m :: * -> *).
(Data m, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
$cgmapMp :: forall m (m :: * -> *).
(Data m, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
$cgmapM :: forall m (m :: * -> *).
(Data m, Monad m) =>
(forall d. Data d => d -> m d) -> Cut m -> m (Cut m)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cut m -> u
$cgmapQi :: forall m u.
Data m =>
Int -> (forall d. Data d => d -> u) -> Cut m -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Cut m -> [u]
$cgmapQ :: forall m u. Data m => (forall d. Data d => d -> u) -> Cut m -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cut m -> r
$cgmapQr :: forall m r r'.
Data m =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cut m -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cut m -> r
$cgmapQl :: forall m r r'.
Data m =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cut m -> r
gmapT :: (forall b. Data b => b -> b) -> Cut m -> Cut m
$cgmapT :: forall m. Data m => (forall b. Data b => b -> b) -> Cut m -> Cut m
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Cut m))
$cdataCast2 :: forall m (t :: * -> * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Cut m))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Cut m))
$cdataCast1 :: forall m (t :: * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Cut m))
dataTypeOf :: Cut m -> DataType
$cdataTypeOf :: forall m. Data m => Cut m -> DataType
toConstr :: Cut m -> Constr
$ctoConstr :: forall m. Data m => Cut m -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cut m)
$cgunfold :: forall m (c :: * -> *).
Data m =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cut m)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cut m -> c (Cut m)
$cgfoldl :: forall m (c :: * -> *).
Data m =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cut m -> c (Cut m)
Data, Typeable, Int -> Cut m -> ShowS
forall m. Show m => Int -> Cut m -> ShowS
forall m. Show m => [Cut m] -> ShowS
forall m. Show m => Cut m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cut m] -> ShowS
$cshowList :: forall m. Show m => [Cut m] -> ShowS
show :: Cut m -> String
$cshow :: forall m. Show m => Cut m -> String
showsPrec :: Int -> Cut m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> Cut m -> ShowS
Show, ReadPrec [Cut m]
ReadPrec (Cut m)
ReadS [Cut m]
forall m. Read m => ReadPrec [Cut m]
forall m. Read m => ReadPrec (Cut m)
forall m. Read m => Int -> ReadS (Cut m)
forall m. Read m => ReadS [Cut m]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cut m]
$creadListPrec :: forall m. Read m => ReadPrec [Cut m]
readPrec :: ReadPrec (Cut m)
$creadPrec :: forall m. Read m => ReadPrec (Cut m)
readList :: ReadS [Cut m]
$creadList :: forall m. Read m => ReadS [Cut m]
readsPrec :: Int -> ReadS (Cut m)
$creadsPrec :: forall m. Read m => Int -> ReadS (Cut m)
Read, forall a b. a -> Cut b -> Cut a
forall a b. (a -> b) -> Cut a -> Cut b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Cut b -> Cut a
$c<$ :: forall a b. a -> Cut b -> Cut a
fmap :: forall a b. (a -> b) -> Cut a -> Cut b
$cfmap :: forall a b. (a -> b) -> Cut a -> Cut b
Functor, forall a. Eq a => a -> Cut a -> Bool
forall a. Num a => Cut a -> a
forall a. Ord a => Cut a -> a
forall m. Monoid m => Cut m -> m
forall a. Cut a -> Bool
forall a. Cut a -> Int
forall a. Cut a -> [a]
forall a. (a -> a -> a) -> Cut a -> a
forall m a. Monoid m => (a -> m) -> Cut a -> m
forall b a. (b -> a -> b) -> b -> Cut a -> b
forall a b. (a -> b -> b) -> b -> Cut a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Cut a -> a
$cproduct :: forall a. Num a => Cut a -> a
sum :: forall a. Num a => Cut a -> a
$csum :: forall a. Num a => Cut a -> a
minimum :: forall a. Ord a => Cut a -> a
$cminimum :: forall a. Ord a => Cut a -> a
maximum :: forall a. Ord a => Cut a -> a
$cmaximum :: forall a. Ord a => Cut a -> a
elem :: forall a. Eq a => a -> Cut a -> Bool
$celem :: forall a. Eq a => a -> Cut a -> Bool
length :: forall a. Cut a -> Int
$clength :: forall a. Cut a -> Int
null :: forall a. Cut a -> Bool
$cnull :: forall a. Cut a -> Bool
toList :: forall a. Cut a -> [a]
$ctoList :: forall a. Cut a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Cut a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Cut a -> a
foldr1 :: forall a. (a -> a -> a) -> Cut a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Cut a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Cut a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Cut a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Cut a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Cut a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Cut a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Cut a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Cut a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Cut a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Cut a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Cut a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Cut a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Cut a -> m
fold :: forall m. Monoid m => Cut m -> m
$cfold :: forall m. Monoid m => Cut m -> m
Foldable, Functor Cut
Foldable Cut
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Cut (m a) -> m (Cut a)
forall (f :: * -> *) a. Applicative f => Cut (f a) -> f (Cut a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cut a -> m (Cut b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cut a -> f (Cut b)
sequence :: forall (m :: * -> *) a. Monad m => Cut (m a) -> m (Cut a)
$csequence :: forall (m :: * -> *) a. Monad m => Cut (m a) -> m (Cut a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cut a -> m (Cut b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cut a -> m (Cut b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Cut (f a) -> f (Cut a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Cut (f a) -> f (Cut a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cut a -> f (Cut b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cut a -> f (Cut b)
Traversable)

-- | If @m@ is a @Semigroup@, then @Cut m@ is a semigroup which
--   contains @m@ as a sub-semigroup, but also contains elements of
--   the form @m1 :||: m2@.  When elements of @m@ combine with such
--   \"cut\" elements they are combined with the value on the
--   corresponding side of the cut (/e.g./ @(Uncut m1) \<\> (m1' :||:
--   m2) = (m1 \<\> m1') :||: m2@).  When two \"cut\" elements meet, the
--   two inside values are thrown away and only the outside values are
--   kept.
instance Semigroup m => Semigroup (Cut m) where
  (Uncut m
m1)    <> :: Cut m -> Cut m -> Cut m
<> (Uncut m
m2)    = forall m. m -> Cut m
Uncut (m
m1 forall a. Semigroup a => a -> a -> a
<> m
m2)
  (Uncut m
m1)    <> (m
m1' :||: m
m2) = m
m1 forall a. Semigroup a => a -> a -> a
<> m
m1' forall m. m -> m -> Cut m
:||: m
m2
  (m
m1  :||: m
m2) <> (Uncut m
m2')   = m
m1        forall m. m -> m -> Cut m
:||: m
m2 forall a. Semigroup a => a -> a -> a
<> m
m2'
  (m
m11 :||: m
_)  <> (m
_ :||: m
m22)  = m
m11       forall m. m -> m -> Cut m
:||: m
m22

  stimes :: forall b. Integral b => b -> Cut m -> Cut m
stimes b
n (Uncut m
m) = forall m. m -> Cut m
Uncut (forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n m
m)
  stimes b
_ (Cut m
m      ) = Cut m
m

instance (Semigroup m, Monoid m) => Monoid (Cut m) where
  mempty :: Cut m
mempty  = forall m. m -> Cut m
Uncut forall a. Monoid a => a
mempty
  mappend :: Cut m -> Cut m -> Cut m
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | A convenient name for @mempty :||: mempty@, so composing with
-- @cut@ introduces a cut point.  For example, @Uncut a \<\> cut \<\>
-- Uncut b == a :||: b@.
cut :: Monoid m => Cut m
cut :: forall m. Monoid m => Cut m
cut = forall a. Monoid a => a
mempty forall m. m -> m -> Cut m
:||: forall a. Monoid a => a
mempty

-- Note that it is impossible for a cut monoid to have an action in
-- general -- the composition operation can throw away information so
-- it is impossible to satisfy the law (act (m1 <> m2) x = act m1 (act
-- m2 x)) in general (although it may be possible for specific types
-- x).