content: {- |
  Module      :  Control.Comonad.Sheet.Manipulate
  Description :  Generic functions for manipulating multi-dimensional comonadic spreadsheets.
  Copyright   :  Copyright (c) 2014 Kenneth Foner
  
  Maintainer  :  kenneth.foner@gmail.com
  Stability   :  experimental
  Portability :  non-portable
  
  This module defines the 'take', 'view', 'go', and 'insert' functions generically for any dimensionality of sheet. These
  constitute the preferred way of manipulating sheets, providing an interface to: take finite slices ('take'), infinite
  slices ('view'), move to locations ('go'), and insert finite or infinite structures ('insert').
  -}
  
  {-# LANGUAGE DataKinds             #-}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE TypeFamilies          #-}
  {-# LANGUAGE TypeOperators         #-}
  {-# LANGUAGE UndecidableInstances  #-}
  
  module Control.Comonad.Sheet.Manipulate where
  
  import Data.Stream.Tape
  import Control.Comonad.Sheet.Indexed
  import Data.Numeric.Witness.Peano
  import Data.Functor.Nested
  import Control.Comonad.Sheet.Reference
  import Data.List.Indexed hiding ( replicate )
  
  import Data.Stream ( Stream(..) , (<:>) )
  import qualified Data.Stream as S
  
  import Control.Applicative
  import Prelude hiding ( take )
  
  class Take r t where
     -- | The type of an n-dimensional list extracted from an n-dimensional sheet. For instance:
     --
     -- > ListFrom Sheet2 a == [[a]]
     type ListFrom t a
     -- | Given a 'RefList' and an n-dimensional sheet, return an n-dimensional list corresponding to taking items from
     --   the space until reaching the (relative or absolute) coordinates specified.
     take :: RefList r -> t a -> ListFrom t a
  
  class View r t where
     -- | The type of an n-dimensional stream extracted from an n-dimensional sheet. For instance:
     --
     -- > StreamFrom Sheet2 a == Stream (Stream a)
     type StreamFrom t a
     -- | Given a 'RefList' and an n-dimensional sheet, return an n-dimensional stream corresponding to the "view" in the
     --   direction specified by the sign of each of the coordinates. The direction implied by an absolute coordinate is
     --   the direction from the current focus to that location.
     view :: RefList r -> t a -> StreamFrom t a
  
  class Go r t where
     -- | Given a 'RefList' and an n-dimensional sheet, move to the location specified by the @RefList@ given.
     go :: RefList r -> t a -> t a
  
  -- | Combination of 'go' and 'take': moves to the location specified by the first argument, then takes the amount
  --   specified by the second argument.
  slice :: (Take r' t, Go r t) => RefList r -> RefList r' -> t a -> ListFrom t a
  slice r r' = take r' . go r
  
  -- | Use this to insert a (possibly nested) list-like structure into a (possibly many-dimensional) sheet.
  --   Note that the depth of nesting of the structure being inserted must match the number of dimensions of the sheet
  --   into which it is being inserted. Note also that the structure being inserted need not be a @Nested@ type; it
  --   need only have enough levels of structure (i.e. number of nested lists) to match the dimensionality of the sheet.
  insert :: (DimensionalAs x (t a), InsertNested l t, AsDimensionalAs x (t a) ~ l a) => x -> t a -> t a
  insert l t = insertNested (l `asDimensionalAs` t) t
  
  -- | Take (n + 1) things from a 'Tape', either in the rightward or leftward directions, depending on the sign of the
  --   reference given. If the reference is @(Rel 0)@, return the empty list.
  tapeTake :: Ref Relative -> Tape a -> [a]
  tapeTake (Rel r) t | r > 0 = focus t : S.take      r  (viewR t)
  tapeTake (Rel r) t | r < 0 = focus t : S.take (abs r) (viewL t)
  tapeTake _ _ = []
  
  instance Take Nil (Nested (Flat Tape)) where
     type ListFrom (Nested (Flat Tape)) a = [a]
     take _ _ = []
  
  instance (Take Nil (Nested ts), Functor (Nested ts)) => Take Nil (Nested (Nest ts Tape)) where
     type ListFrom (Nested (Nest ts Tape)) a = ListFrom (Nested ts) [a]
     take _ = take (Rel 0 :-: ConicNil)
  
  instance Take (Relative :-: Nil) (Nested (Flat Tape)) where
     type ListFrom (Nested (Flat Tape)) a = [a]
     take (r :-: _) (Flat t) = tapeTake r t
  
  instance ( Functor (Nested ts), Take rs (Nested ts) )
           => Take (Relative :-: rs) (Nested (Nest ts Tape)) where
     type ListFrom (Nested (Nest ts Tape)) a = ListFrom (Nested ts) [a]
     take (r :-: rs) (Nest t) = take rs . fmap (tapeTake r) $ t
  
  instance ( Take (Replicate (NestedCount ts) Relative) (Nested ts)
           , Length r <= NestedCount ts
           , ((NestedCount ts - Length r) + Length r) ~ NestedCount ts
           ) => Take r (Indexed ts) where
     type ListFrom (Indexed ts) a = ListFrom (Nested ts) a
     take r (Indexed i t) = take (heterogenize id (getMovement r i)) t
  
  -- | Given a relative reference, either return the rightward-pointing stream or the leftward one, depending on the
  --   sign of the reference. @(Rel 0)@ defaults to rightward.
  tapeView :: Ref Relative -> Tape a -> Stream a
  tapeView (Rel r) t | r >= 0    = focus t <:> viewR t
  tapeView (Rel r) t | otherwise = focus t <:> viewL t
  
  instance View Nil (Nested (Flat Tape)) where
     type StreamFrom (Nested (Flat Tape)) a = Stream a
     view _ (Flat t) = tapeView (Rel 0) t
  
  instance (View Nil (Nested ts), Functor (Nested ts)) => View Nil (Nested (Nest ts Tape)) where
     type StreamFrom (Nested (Nest ts Tape)) a = StreamFrom (Nested ts) (Stream a)
     view _ = view (Rel 0 :-: ConicNil)
  
  instance View (Relative :-: Nil) (Nested (Flat Tape)) where
     type StreamFrom (Nested (Flat Tape)) a = (Stream a)
     view (r :-: _) (Flat t) = tapeView r t
  
  instance ( Functor (Nested ts), View rs (Nested ts) )
           => View (Relative :-: rs) (Nested (Nest ts Tape)) where
     type StreamFrom (Nested (Nest ts Tape)) a = StreamFrom (Nested ts) (Stream a)
     view (r :-: rs) (Nest t) = view rs . fmap (tapeView r) $ t
  
  instance ( View (Replicate (NestedCount ts) Relative) (Nested ts)
           , Length r <= NestedCount ts
           , ((NestedCount ts - Length r) + Length r) ~ NestedCount ts
           ) => View r (Indexed ts) where
     type StreamFrom (Indexed ts) a = StreamFrom (Nested ts) a
     view r (Indexed i t) = view (heterogenize id (getMovement r i)) t
  
  -- | Given a relative reference, move that much in a 'Tape', either rightward or leftward depending on sign.
  tapeGo :: Ref Relative -> Tape a -> Tape a
  tapeGo (Rel r) = fpow (abs r) (if r > 0 then moveR else moveL)
     where fpow n = foldr (.) id . replicate n -- iterate a function n times
  
  instance Go (Relative :-: Nil) (Nested (Flat Tape)) where
     go (r :-: _) (Flat t) = Flat $ tapeGo r t
  
  instance Go Nil (Nested ts) where go _ = id
  
  instance (Go rs (Nested ts), Functor (Nested ts)) => Go (Relative :-: rs) (Nested (Nest ts Tape)) where
     go (r :-: rs) (Nest t) = Nest . go rs . fmap (tapeGo r) $ t
  
  instance ( Go (Replicate (NestedCount ts) Relative) (Nested ts)
           , Length r <= NestedCount ts
           , ((NestedCount ts - Length r) + Length r) ~ NestedCount ts
           , ReifyNatural (NestedCount ts) )
           => Go r (Indexed ts) where
     go r (Indexed i t) =
        let move = getMovement r i
        in  Indexed (merge move i) (go (heterogenize id move) t)
  
  -- | A @(Signed f a)@ is an @(f a)@ annotated with a sign: either @Positive@ or @Negative@. This is a useful type for
  --   specifying the directionality of insertions into sheets. By wrapping a list or stream in a @Negative@ and then
  --   inserting it into a sheet, you insert it in the opposite direction to the usual one: leftward, upward, inward...
  data Signed f a = Positive (f a)
                  | Negative (f a)
                  deriving ( Eq , Ord , Show )
  
  -- | In order to insert an n-dimensional list-like structure @(l a)@ into an n-dimensional @Tape@, it's only necessary
  --   to define how to insert a 1-dimensional @(l a)@ into a 1-dimensional @Tape@. Add instances of this class if you
  --   want to be able to insert custom types into a sheet.
  class InsertBase l where
     insertBase :: l a -> Tape a -> Tape a
  
  -- | Inserting a @Tape@ into another @Tape@ replaces the latter with the former completely.
  instance InsertBase Tape where
     insertBase t _ = t
  
  -- | Inserting a @Stream@ into a @Tape@ replaces the focus and right side of the @Tape@ with the contents of the stream.
  instance InsertBase Stream where
     insertBase (Cons x xs) (Tape ls _ _) = Tape ls x xs
  
  -- | Inserting a @Signed Stream@ into a @Tape@ either behaves just like inserting a regular @Stream@, or (in the @Negative@ case) inserts the stream to the left.
  instance InsertBase (Signed Stream) where
     insertBase (Positive (Cons x xs)) (Tape ls _ _) = Tape ls x xs
     insertBase (Negative (Cons x xs)) (Tape _ _ rs) = Tape xs x rs
  
  -- | Inserting a list into a @Tape@ prepends the contents of the list rightwards in the @Tape@, pushing the old focus
  --   element rightward (i.e. the head of the list becomes the new focus).
  instance InsertBase [] where
     insertBase [] t = t
     insertBase (x : xs) (Tape ls c rs) =
        Tape ls x (S.prefix xs (Cons c rs))
  
  -- | Inserting a @Signed []@ into a @Tape@ either behaves just like inserting a regular list, or (in the @Negative@ case) inserts the list to the left.
  instance InsertBase (Signed []) where
     insertBase (Positive []) t = t
     insertBase (Negative []) t = t
     insertBase (Positive (x : xs)) (Tape ls c rs) =
        Tape ls x (S.prefix xs (Cons c rs))
     insertBase (Negative (x : xs)) (Tape ls c rs) =
        Tape (S.prefix xs (Cons c ls)) x rs
  
  -- | This typeclass is the inductive definition for inserting things into higher-dimensional spaces. To make new types
  --   insertable, add instances of 'InsertBase', not @InsertNested@.
  class InsertNested l t where
     insertNested :: l a -> t a -> t a
  
  instance (InsertBase l) => InsertNested (Nested (Flat l)) (Nested (Flat Tape)) where
     insertNested (Flat l) (Flat t) = Flat $ insertBase l t
  
  instance ( InsertBase l , InsertNested (Nested ls) (Nested ts)
           , Functor (Nested ls) , Applicative (Nested ts) )
           => InsertNested (Nested (Nest ls l)) (Nested (Nest ts Tape)) where
     insertNested (Nest l) (Nest t) =
        Nest $ insertNested (insertBase <$> l) (pure id) <*> t
  
  instance (InsertNested l (Nested ts)) => InsertNested l (Indexed ts) where
     insertNested l (Indexed i t) = Indexed i (insertNested l t)
  
  -- | @DimensionalAs@ provides a mechanism to "lift" an n-deep nested structure into an explicit @Nested@ type. This
  --   is the way in which raw lists-of-lists-of-lists, etc. can be inserted (without manual annotation of nesting depth)
  --   into a sheet.
  class DimensionalAs x y where
     type AsDimensionalAs x y
     -- | @x `asDimensionalAs` y@ applies the appropriate constructors for 'Nested' to @x@ a number of times equal to
     --   the number of dimensions of @y@. For instance:
     --
     --   > [['x']] `asDimensionalAs` Nest (Flat [['y']]) == Nest (Flat [['x']])
     asDimensionalAs :: x -> y -> x `AsDimensionalAs` y
  
  -- | In the case of a @Nested@ structure, @asDimensionalAs@ defaults to @asNestedAs@.
  instance (NestedAs x (Nested ts y), AsDimensionalAs x (Nested ts y) ~ AsNestedAs x (Nested ts y)) => DimensionalAs x (Nested ts y) where
     type x `AsDimensionalAs` (Nested ts a) = x `AsNestedAs` (Nested ts a)
     asDimensionalAs = asNestedAs
  
  -- | @DimensionalAs@ also knows the dimensionality of an 'Indexed' sheet as well as regular @Nested@ structures.
  instance (NestedAs x (Nested ts y)) => DimensionalAs x (Indexed ts y) where
     type x `AsDimensionalAs` (Indexed ts a) = x `AsNestedAs` (Nested ts a)
     x `asDimensionalAs` (Indexed i t)       = x `asNestedAs` t
  