{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# OPTIONS_GHC -fno-warn-unused-imports       #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Monoid.Deletable
-- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- A monoid transformer that allows deleting information from a
-- concatenation of monoidal values.
--
-----------------------------------------------------------------------------

module Data.Monoid.Deletable
       ( Deletable(..)

       , unDelete, toDeletable

       , deleteL, deleteR

       ) where

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

-- | If @m@ is a 'Monoid', then @Deletable m@ (intuitively speaking)
--   adds two distinguished new elements @[@ and @]@, such that an
--   occurrence of [ \"deletes\" everything from it to the next ]. For
--   example,
--
--   > abc[def]gh == abcgh
--
--   This is all you really need to know to /use/ @Deletable m@
--   values; to understand the actual implementation, read on.
--
--   To properly deal with nesting and associativity we need to be
--   able to assign meanings to things like @[[@, @][@, and so on. (We
--   cannot just define, say, @[[ == [@, since then @([[)] == [] ==
--   id@ but @[([]) == [id == [@.)  Formally, elements of @Deletable
--   m@ are triples of the form (r, m, l) representing words @]^r m
--   [^l@.  When combining two triples (r1, m1, l1) and (r2, m2, l2)
--   there are three cases:
--
--   * If l1 == r2 then the [s from the left and ]s from the right
--     exactly cancel, and we are left with (r1, m1 \<\> m2, l2).
--
--   * If l1 < r2 then all of the [s cancel with some of the ]s, but
--     m1 is still inside the remaining ]s and is deleted, yielding (r1
--     + r2 - l1, m2, l2)
--
--   * The remaining case is symmetric with the second.

data Deletable m = Deletable Int m Int
  deriving (Deletable m -> DataType
Deletable m -> Constr
forall {m}. Data m => Typeable (Deletable m)
forall m. Data m => Deletable m -> DataType
forall m. Data m => Deletable m -> Constr
forall m.
Data m =>
(forall b. Data b => b -> b) -> Deletable m -> Deletable m
forall m u.
Data m =>
Int -> (forall d. Data d => d -> u) -> Deletable m -> u
forall m u.
Data m =>
(forall d. Data d => d -> u) -> Deletable m -> [u]
forall m r r'.
Data m =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Deletable m -> r
forall m r r'.
Data m =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Deletable m -> r
forall m (m :: * -> *).
(Data m, Monad m) =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
forall m (m :: * -> *).
(Data m, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
forall m (c :: * -> *).
Data m =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Deletable m)
forall m (c :: * -> *).
Data m =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deletable m -> c (Deletable m)
forall m (t :: * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Deletable m))
forall m (t :: * -> * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Deletable 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 (Deletable m)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deletable m -> c (Deletable m)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Deletable m))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
$cgmapMo :: forall m (m :: * -> *).
(Data m, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
$cgmapMp :: forall m (m :: * -> *).
(Data m, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
$cgmapM :: forall m (m :: * -> *).
(Data m, Monad m) =>
(forall d. Data d => d -> m d) -> Deletable m -> m (Deletable m)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Deletable m -> u
$cgmapQi :: forall m u.
Data m =>
Int -> (forall d. Data d => d -> u) -> Deletable m -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Deletable m -> [u]
$cgmapQ :: forall m u.
Data m =>
(forall d. Data d => d -> u) -> Deletable m -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Deletable m -> r
$cgmapQr :: forall m r r'.
Data m =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Deletable m -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Deletable m -> r
$cgmapQl :: forall m r r'.
Data m =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Deletable m -> r
gmapT :: (forall b. Data b => b -> b) -> Deletable m -> Deletable m
$cgmapT :: forall m.
Data m =>
(forall b. Data b => b -> b) -> Deletable m -> Deletable m
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Deletable m))
$cdataCast2 :: forall m (t :: * -> * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Deletable m))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Deletable m))
$cdataCast1 :: forall m (t :: * -> *) (c :: * -> *).
(Data m, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Deletable m))
dataTypeOf :: Deletable m -> DataType
$cdataTypeOf :: forall m. Data m => Deletable m -> DataType
toConstr :: Deletable m -> Constr
$ctoConstr :: forall m. Data m => Deletable m -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Deletable m)
$cgunfold :: forall m (c :: * -> *).
Data m =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Deletable m)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deletable m -> c (Deletable m)
$cgfoldl :: forall m (c :: * -> *).
Data m =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deletable m -> c (Deletable m)
Data, Typeable, Int -> Deletable m -> ShowS
forall m. Show m => Int -> Deletable m -> ShowS
forall m. Show m => [Deletable m] -> ShowS
forall m. Show m => Deletable m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Deletable m] -> ShowS
$cshowList :: forall m. Show m => [Deletable m] -> ShowS
show :: Deletable m -> String
$cshow :: forall m. Show m => Deletable m -> String
showsPrec :: Int -> Deletable m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> Deletable m -> ShowS
Show, ReadPrec [Deletable m]
ReadPrec (Deletable m)
ReadS [Deletable m]
forall m. Read m => ReadPrec [Deletable m]
forall m. Read m => ReadPrec (Deletable m)
forall m. Read m => Int -> ReadS (Deletable m)
forall m. Read m => ReadS [Deletable m]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Deletable m]
$creadListPrec :: forall m. Read m => ReadPrec [Deletable m]
readPrec :: ReadPrec (Deletable m)
$creadPrec :: forall m. Read m => ReadPrec (Deletable m)
readList :: ReadS [Deletable m]
$creadList :: forall m. Read m => ReadS [Deletable m]
readsPrec :: Int -> ReadS (Deletable m)
$creadsPrec :: forall m. Read m => Int -> ReadS (Deletable m)
Read, forall a b. a -> Deletable b -> Deletable a
forall a b. (a -> b) -> Deletable a -> Deletable 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 -> Deletable b -> Deletable a
$c<$ :: forall a b. a -> Deletable b -> Deletable a
fmap :: forall a b. (a -> b) -> Deletable a -> Deletable b
$cfmap :: forall a b. (a -> b) -> Deletable a -> Deletable b
Functor, forall a. Eq a => a -> Deletable a -> Bool
forall a. Num a => Deletable a -> a
forall a. Ord a => Deletable a -> a
forall m. Monoid m => Deletable m -> m
forall a. Deletable a -> Bool
forall a. Deletable a -> Int
forall a. Deletable a -> [a]
forall a. (a -> a -> a) -> Deletable a -> a
forall m a. Monoid m => (a -> m) -> Deletable a -> m
forall b a. (b -> a -> b) -> b -> Deletable a -> b
forall a b. (a -> b -> b) -> b -> Deletable 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 => Deletable a -> a
$cproduct :: forall a. Num a => Deletable a -> a
sum :: forall a. Num a => Deletable a -> a
$csum :: forall a. Num a => Deletable a -> a
minimum :: forall a. Ord a => Deletable a -> a
$cminimum :: forall a. Ord a => Deletable a -> a
maximum :: forall a. Ord a => Deletable a -> a
$cmaximum :: forall a. Ord a => Deletable a -> a
elem :: forall a. Eq a => a -> Deletable a -> Bool
$celem :: forall a. Eq a => a -> Deletable a -> Bool
length :: forall a. Deletable a -> Int
$clength :: forall a. Deletable a -> Int
null :: forall a. Deletable a -> Bool
$cnull :: forall a. Deletable a -> Bool
toList :: forall a. Deletable a -> [a]
$ctoList :: forall a. Deletable a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Deletable a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Deletable a -> a
foldr1 :: forall a. (a -> a -> a) -> Deletable a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Deletable a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Deletable a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Deletable a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Deletable a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Deletable a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Deletable a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Deletable a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Deletable a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Deletable a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Deletable a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Deletable a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Deletable a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Deletable a -> m
fold :: forall m. Monoid m => Deletable m -> m
$cfold :: forall m. Monoid m => Deletable m -> m
Foldable, Functor Deletable
Foldable Deletable
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 =>
Deletable (m a) -> m (Deletable a)
forall (f :: * -> *) a.
Applicative f =>
Deletable (f a) -> f (Deletable a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Deletable a -> m (Deletable b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Deletable a -> f (Deletable b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Deletable (m a) -> m (Deletable a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Deletable (m a) -> m (Deletable a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Deletable a -> m (Deletable b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Deletable a -> m (Deletable b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Deletable (f a) -> f (Deletable a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Deletable (f a) -> f (Deletable a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Deletable a -> f (Deletable b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Deletable a -> f (Deletable b)
Traversable)

-- | Project the wrapped value out of a `Deletable` value.
unDelete :: Deletable m -> m
unDelete :: forall m. Deletable m -> m
unDelete (Deletable Int
_ m
m Int
_) = m
m

-- | Inject a value into a `Deletable` wrapper.  Satisfies the
--   property
--
-- > unDelete . toDeletable === id
--
toDeletable :: m -> Deletable m
toDeletable :: forall m. m -> Deletable m
toDeletable m
m = forall m. Int -> m -> Int -> Deletable m
Deletable Int
0 m
m Int
0

instance Semigroup m => Semigroup (Deletable m) where
  (Deletable Int
r1 m
m1 Int
l1) <> :: Deletable m -> Deletable m -> Deletable m
<> (Deletable Int
r2 m
m2 Int
l2)
    | Int
l1 forall a. Eq a => a -> a -> Bool
== Int
r2  = forall m. Int -> m -> Int -> Deletable m
Deletable Int
r1 (m
m1 forall a. Semigroup a => a -> a -> a
<> m
m2) Int
l2
    | Int
l1 forall a. Ord a => a -> a -> Bool
<  Int
r2  = forall m. Int -> m -> Int -> Deletable m
Deletable (Int
r1 forall a. Num a => a -> a -> a
+ Int
r2 forall a. Num a => a -> a -> a
- Int
l1) m
m2 Int
l2
    | Bool
otherwise = forall m. Int -> m -> Int -> Deletable m
Deletable Int
r1 m
m1 (Int
l2 forall a. Num a => a -> a -> a
+ Int
l1 forall a. Num a => a -> a -> a
- Int
r2)

  stimes :: forall b. Integral b => b -> Deletable m -> Deletable m
stimes b
n (Deletable Int
r m
m Int
l)
    | Int
r forall a. Eq a => a -> a -> Bool
== Int
l    = forall m. Int -> m -> Int -> Deletable m
Deletable Int
r (forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n m
m) Int
l
    | Int
l forall a. Ord a => a -> a -> Bool
<  Int
r    = forall m. Int -> m -> Int -> Deletable m
Deletable (Int
iforall a. Num a => a -> a -> a
*(Int
rforall a. Num a => a -> a -> a
-Int
l) forall a. Num a => a -> a -> a
+ Int
l) m
m Int
l
    | Bool
otherwise = forall m. Int -> m -> Int -> Deletable m
Deletable Int
r m
m (Int
iforall a. Num a => a -> a -> a
*(Int
lforall a. Num a => a -> a -> a
-Int
r) forall a. Num a => a -> a -> a
+ Int
r)
    where
      i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n :: Int

instance (Semigroup m, Monoid m) => Monoid (Deletable m) where
  mempty :: Deletable m
mempty = forall m. Int -> m -> Int -> Deletable m
Deletable Int
0 forall a. Monoid a => a
mempty Int
0
  mappend :: Deletable m -> Deletable m -> Deletable m
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | A \"left bracket\", which causes everything between it and the
--   next right bracket to be deleted.
deleteL :: Monoid m => Deletable m
deleteL :: forall m. Monoid m => Deletable m
deleteL = forall m. Int -> m -> Int -> Deletable m
Deletable Int
0 forall a. Monoid a => a
mempty Int
1

-- | A \"right bracket\", denoting the end of the section that should
--   be deleted.
deleteR :: Monoid m => Deletable m
deleteR :: forall m. Monoid m => Deletable m
deleteR = forall m. Int -> m -> Int -> Deletable m
Deletable Int
1 forall a. Monoid a => a
mempty Int
0