{-# LANGUAGE DeriveFunctor, CPP, Trustworthy, GeneralizedNewtypeDeriving #-}
-- | See "Data.Compositions.Snoc" for normal day-to-day use. This module contains the implementation of that module.
module Data.Compositions.Snoc.Internal where

import qualified Data.Compositions as C
import Prelude hiding (sum, drop, take, length, concatMap, splitAt)
import Data.Monoid
#if __GLASGOW_HASKELL__ == 708
import Data.Foldable
#endif
#if __GLASGOW_HASKELL__ >= 710
import Data.Foldable hiding (length)
#endif

{-# RULES
 "drop/composed" [~2] forall n xs. composed (drop n xs) = dropComposed n xs
  #-}
-- $setup
-- >>> :set -XScopedTypeVariables
-- >>> import Control.Applicative
-- >>> import Test.QuickCheck
-- >>> import qualified Data.List as List
-- >>> type Element = [Int]
-- >>> newtype C = Compositions (Compositions Element) deriving (Show, Eq)
-- >>> instance (Monoid a, Arbitrary a) => Arbitrary (Compositions a) where arbitrary = fromList <$> arbitrary
-- >>> instance Arbitrary C where arbitrary = Compositions <$> arbitrary

newtype Flip a = Flip { unflip :: a } deriving (Functor, Eq)

#if __GLASGOW_HASKELL__ >= 840
instance Semigroup a => Semigroup (Flip a) where
  (Flip a) <> (Flip b) = Flip $ a <> b

instance Monoid a => Monoid (Flip a) where
  mempty = Flip mempty
#else
instance Monoid a => Monoid (Flip a) where
  mempty = Flip mempty
  mappend (Flip a) (Flip b) = Flip (mappend b a)
#endif

-- | A /compositions list/ or /composition tree/ is a list data type
-- where the elements are monoids, and the 'mconcat' of any contiguous sublist can be
-- computed in logarithmic time.
-- A common use case of this type is in a wiki, version control system, or collaborative editor, where each change
-- or delta would be stored in a list, and it is sometimes necessary to compute the composed delta between any two versions.
--
-- This version of a composition list is strictly biased to left-associativity, in that we only support efficient snoccing
-- to the end of the list. This also means that the 'drop' operation can be inefficient. The append operation @a <> b@
-- performs O(b log (a + b)) element compositions, so you want the right-hand list @b@ to be as small as possible.
--
-- For a version biased to consing, see "Data.Compositions". This gives the opposite performance characteristics,
-- where 'take' is slow and 'drop' is fast.
--
-- __Monoid laws:__
--
-- prop> \(Compositions l) -> mempty <> l == l
-- prop> \(Compositions l) -> l <> mempty == l
-- prop> \(Compositions t) (Compositions u) (Compositions v) -> t <> (u <> v) == (t <> u) <> v
--
-- __'toList' is monoid morphism__:
--
-- prop> toList (mempty :: Compositions Element) == []
-- prop> \(Compositions a) (Compositions b) -> toList (a <> b) == toList a ++ toList b
--
newtype Compositions a = C { unC :: C.Compositions (Flip a) } deriving (Eq)

#if __GLASGOW_HASKELL__ >= 840
instance Semigroup a => Semigroup (Compositions a) where
  (C a) <> (C b) = C $ b <> a

instance Monoid a => Monoid (Compositions a) where
  mempyt = C mempty
#else
instance Monoid a => Monoid (Compositions a) where
  mempty = C mempty
  mappend (C a) (C b) = C $ b <> a
#endif

instance Foldable Compositions where
  foldMap f (C x) = foldMap (f . unflip) . reverse $ toList x

instance Show a => Show (Compositions a) where
  show ls = "fromList " ++ show (toList ls)

instance (Monoid a, Read a) => Read (Compositions a) where
  readsPrec _  ('f':'r':'o':'m':'L':'i':'s':'t':' ':r) = map (\(a,s) -> (fromList a, s)) $ reads r
  readsPrec _  _ = []

-- | Convert a compositions list into a list of elements. The other direction
--   is provided in the 'Data.Foldable.Foldable' instance. This will perform O(n log n) element compositions.
--
-- __Isomorphism to lists__:
--
-- prop> \(Compositions x) -> fromList (toList x) == x
-- prop> \(x :: [Element]) -> toList (fromList x) == x
--
-- __Is monoid morphism__:
--
-- prop> fromList ([] :: [Element]) == mempty
-- prop> \(a :: [Element]) b -> fromList (a ++ b) == fromList a <> fromList b
fromList :: Monoid a => [a] -> Compositions a
fromList = C . C.fromList . map Flip . reverse

-- | Construct a compositions list containing just one element.
--
-- prop> \(x :: Element) -> singleton x == snoc mempty x
-- prop> \(x :: Element) -> composed (singleton x) == x
-- prop> \(x :: Element) -> length (singleton x) == 1
--
-- __Refinement of singleton lists__:
--
-- prop> \(x :: Element) -> toList (singleton x) == [x]
-- prop> \(x :: Element) -> singleton x == fromList [x]
singleton :: Monoid a => a -> Compositions a
singleton = C . C.singleton . Flip

-- | Only valid if the function given is a monoid morphism 
--
--   Otherwise, use @fromList . map f . toList@ (which is much slower).
unsafeMap :: (a -> b) -> Compositions a -> Compositions b
unsafeMap f = C . C.unsafeMap (fmap f) . unC

-- | Return the compositions list with the first /k/ elements removed.
--   In the worst case, performs __O(k log k)__ element compositions,
--   in order to maintain the left-associative bias. If you wish to run 'composed'
--   on the result of 'drop', use 'dropComposed' for better performance.
--   Rewrite @RULES@ are provided for compilers which support them.
--
-- prop> \(Compositions l) (Positive n) (Positive m) -> drop n (drop m l) == drop m (drop n l)
-- prop> \(Compositions l) (Positive n) (Positive m) -> drop n (drop m l) == drop (m + n) l
-- prop> \(Compositions l) (Positive n) -> length (drop n l) == max (length l - n) 0
-- prop> \(Compositions t) (Compositions u) -> drop (length t) (t <> u) == u
-- prop> \(Compositions l) -> drop 0 l == l
-- prop> \n -> drop n (mempty :: Compositions Element) == mempty
--
-- __Refinement of 'Data.List.drop'__:
--
-- prop> \(l :: [Element]) n -> drop n (fromList l) == fromList (List.drop n l)
-- prop> \(Compositions l) n -> toList (drop n l) == List.drop n (toList l)
drop :: Monoid a => Int -> Compositions a -> Compositions a
drop i (C x) = C $ C.take (C.length x - i) x

-- | Return the compositions list containing only the first /k/ elements
--   of the input, in O(log k) time.
--
--  prop> \(Compositions l) (Positive n) (Positive m) -> take n (take m l) == take m (take n l)
--  prop> \(Compositions l) (Positive n) (Positive m) -> take m (take n l) == take (m `min` n) l
--  prop> \(Compositions l) (Positive n) -> length (take n l) == min (length l) n
--  prop> \(Compositions l) -> take (length l) l == l
--  prop> \(Compositions l) (Positive n) -> take (length l + n) l == l
--  prop> \(Positive n) -> take n (mempty :: Compositions Element) == mempty
--
--  __Refinement of 'Data.List.take'__:
--
--  prop> \(l :: [Element]) n -> take n (fromList l) == fromList (List.take n l)
--  prop> \(Compositions l) n -> toList (take n l) == List.take n (toList l)
--
--  prop> \(Compositions l) (Positive n) -> take n l <> drop n l == l
take :: Monoid a => Int -> Compositions a -> Compositions a
take i (C x) = C $ C.drop (C.length x - i) x


-- | Returns the composition of the list with the first /k/ elements removed, doing only O(log k) compositions.
-- Faster than simply using 'drop' and then 'composed' separately.
--
-- prop> \(Compositions l) n -> dropComposed n l == composed (drop n l)
-- prop> \(Compositions l) -> dropComposed 0 l == composed l
dropComposed :: Monoid a => Int -> Compositions a -> a
dropComposed i (C x) = unflip $ C.takeComposed (C.length x - i) x

-- | A convenience alias for 'take' and 'drop'
--
-- prop> \(Compositions l) i -> splitAt i l == (take i l, drop i l)
{-# INLINE splitAt #-}
splitAt :: Monoid a => Int -> Compositions a -> (Compositions a, Compositions a)
splitAt i c = (take i c, drop i c)

-- | Compose every element in the compositions list. Performs only
-- O(log n) compositions.
--
-- __Refinement of 'mconcat'__:
--
-- prop> \(l :: [Element]) -> composed (fromList l) == mconcat l
-- prop> \(Compositions l) -> composed l == mconcat (toList l)
--
-- __Is a monoid morphism__:
--
-- prop> \(Compositions a) (Compositions b) -> composed (a <> b) == composed a <> composed b
-- prop> composed mempty == (mempty :: Element)
{-# INLINE[2] composed #-}
composed :: Monoid a => Compositions a -> a
composed = unflip . C.composed . unC

-- | Get the number of elements in the compositions list, in O(log n) time.
--
-- __Is a monoid morphism__:
--
-- prop> length (mempty :: Compositions Element) == 0
-- prop> \(Compositions a) (Compositions b) -> length (a <> b) == length a + length b
--
-- __Refinement of 'Data.List.length'__:
--
-- prop> \(x :: [Element]) -> length (fromList x) == List.length x
-- prop> \(Compositions x) -> length x == List.length (toList x)
length :: Compositions a -> Int
length = C.length . unC

-- | Add a new element to the end of a compositions list. Performs O(log n) element compositions.
--
-- prop> \(x :: Element) (Compositions xs) -> snoc xs x == xs <> singleton x
-- prop> \(x :: Element) (Compositions xs) -> length (snoc xs x) == length xs + 1
--
-- __Refinement of List snoc__:
--
-- prop> \(x :: Element) (xs :: [Element]) -> snoc (fromList xs) x == fromList (xs ++ [x])
-- prop> \(x :: Element) (Compositions xs) -> toList (snoc xs x) == toList xs ++ [x]
snoc :: Monoid a => Compositions a -> a -> Compositions a
snoc (C xs) x = C (C.cons (Flip x) xs)