{-# LANGUAGE CPP, PatternGuards, BangPatterns #-}
#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Stream.Infinite.Functional.Zipper
-- Copyright   :  (C) 2011-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- This is an infinite bidirectional zipper
----------------------------------------------------------------------------
module Data.Stream.Infinite.Functional.Zipper (
   -- * The type of streams
     Zipper(..)
   , tail   -- :: Zipper a -> Zipper a
   , untail -- :: Zipper a -> Zipper a
   , intersperse -- :: a -> Zipper a -> Zipper a
   , interleave  -- :: Zipper a -> Zipper a -> Zipper a
   , transpose   -- :: Zipper (Zipper a) -> Zipper (Zipper a)
   , take        -- :: Integer -> Zipper a -> [a]
   , drop        -- :: Integer -> Zipper a -> Zipper a -- you can drop a negative number
   , splitAt     -- :: Integer -> Zipper a -> ([a],Zipper a)
   , reverse     -- :: Zipper a -> Zipper a
   , (!!)        -- :: Int -> Zipper a -> a
   , unzip       -- :: Functor f => f (a, b) -> (f a, f b)
   , toSequence  -- :: (Integer -> a) -> Zipper a
   , head
   , (<|)
   , uncons
   , takeWhile
   , dropWhile
   , span
   , break
   , isPrefixOf
   , findIndex
   , elemIndex
   , zip
   , zipWith
   ) where

import Prelude hiding
  ( head, tail, map, scanr, scanr1, scanl, scanl1
  , iterate, take, drop, takeWhile
  , dropWhile, repeat, cycle, filter
  , (!!), zip, unzip, zipWith, words
  , unwords, lines, unlines, break, span
  , splitAt, foldr, reverse
  )

#if !(MIN_VERSION_base(4,18,0))
import Control.Applicative
#endif
import Control.Comonad
#ifdef LANGUAGE_DeriveDataTypeable
import Data.Data
#endif
import Data.Functor.Extend
import Data.Functor.Apply
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif

data Zipper a = !Integer :~ !(Integer -> a)
#ifdef LANGUAGE_DeriveDataTypeable
  deriving Typeable
#endif

toSequence :: (Integer -> a) -> Zipper a
toSequence :: forall a. (Integer -> a) -> Zipper a
toSequence = (Integer
0 forall a. Integer -> (Integer -> a) -> Zipper a
:~)

reverse :: Zipper a -> Zipper a
reverse :: forall a. Zipper a -> Zipper a
reverse (Integer
n :~ Integer -> a
f) = forall a. Num a => a -> a
negate Integer
n forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate

infixr 0 :~

instance Functor Zipper where
  fmap :: forall a b. (a -> b) -> Zipper a -> Zipper b
fmap a -> b
g (Integer
n :~ Integer -> a
f) = Integer
n forall a. Integer -> (Integer -> a) -> Zipper a
:~ a -> b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
f
  a
b <$ :: forall a b. a -> Zipper b -> Zipper a
<$ Zipper b
_ = Integer
0 forall a. Integer -> (Integer -> a) -> Zipper a
:~ forall a b. a -> b -> a
const a
b

-- | Extract the focused element
head :: Zipper a -> a
head :: forall a. Zipper a -> a
head (Integer
n :~ Integer -> a
f) = Integer -> a
f Integer
n

-- | Move the head of the zipper to the right
tail :: Zipper a -> Zipper a
tail :: forall a. Zipper a -> Zipper a
tail (Integer
n :~ Integer -> a
f) = Integer
n forall a. Num a => a -> a -> a
+ Integer
1 forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f

-- | Move the head of the zipper to the left
untail :: Zipper a -> Zipper a
untail :: forall a. Zipper a -> Zipper a
untail (Integer
n :~ Integer -> a
f) = Integer
n forall a. Num a => a -> a -> a
- Integer
1 forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f

-- | Cons before the head of the zipper. The head now points to the new element
(<|) :: a -> Zipper a -> Zipper a
a
a <| :: forall a. a -> Zipper a -> Zipper a
<| (Integer
n :~ Integer -> a
f) = Integer
n forall a. Integer -> (Integer -> a) -> Zipper a
:~ \Integer
z -> case forall a. Ord a => a -> a -> Ordering
compare Integer
z Integer
n of
  Ordering
LT -> Integer -> a
f Integer
n
  Ordering
EQ -> a
a
  Ordering
GT -> Integer -> a
f (Integer
n forall a. Num a => a -> a -> a
- Integer
1)

-- | Move the head of the zipper one step to the right, returning the value we move over.
uncons :: Zipper a -> (a, Zipper a)
uncons :: forall a. Zipper a -> (a, Zipper a)
uncons (Integer
n :~ Integer -> a
f) = (Integer -> a
f Integer
n, Integer
n forall a. Num a => a -> a -> a
+ Integer
1 forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f)

instance Extend Zipper where
  duplicated :: forall a. Zipper a -> Zipper (Zipper a)
duplicated (Integer
n :~ Integer -> a
f) = Integer
n forall a. Integer -> (Integer -> a) -> Zipper a
:~ (forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f)

instance Comonad Zipper where
  duplicate :: forall a. Zipper a -> Zipper (Zipper a)
duplicate (Integer
n :~ Integer -> a
f) = Integer
n forall a. Integer -> (Integer -> a) -> Zipper a
:~ (forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f)
  extract :: forall a. Zipper a -> a
extract (Integer
n :~ Integer -> a
f) = Integer -> a
f Integer
n

instance Apply Zipper where
  (Integer
nf :~ Integer -> a -> b
f) <.> :: forall a b. Zipper (a -> b) -> Zipper a -> Zipper b
<.> (Integer
na :~ Integer -> a
a)
    | Integer
dn <- Integer
na forall a. Num a => a -> a -> a
- Integer
nf
    = Integer
nf forall a. Integer -> (Integer -> a) -> Zipper a
:~ \Integer
n -> Integer -> a -> b
f Integer
n (Integer -> a
a (Integer
n forall a. Num a => a -> a -> a
+ Integer
dn))
  Zipper a
as        <. :: forall a b. Zipper a -> Zipper b -> Zipper a
<.  Zipper b
_         = Zipper a
as
  Zipper a
_          .> :: forall a b. Zipper a -> Zipper b -> Zipper b
.> Zipper b
bs        = Zipper b
bs

instance ComonadApply Zipper where
  <@> :: forall a b. Zipper (a -> b) -> Zipper a -> Zipper b
(<@>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
  <@ :: forall a b. Zipper a -> Zipper b -> Zipper a
(<@) = forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
(<.)
  @> :: forall a b. Zipper a -> Zipper b -> Zipper b
(@>) = forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
(.>)


instance Applicative Zipper where
  pure :: forall a. a -> Zipper a
pure = forall a. a -> Zipper a
repeat
  <*> :: forall a b. Zipper (a -> b) -> Zipper a -> Zipper b
(<*>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
  Zipper a
as <* :: forall a b. Zipper a -> Zipper b -> Zipper a
<* Zipper b
_ = Zipper a
as
  Zipper a
_ *> :: forall a b. Zipper a -> Zipper b -> Zipper b
*> Zipper b
bs = Zipper b
bs

instance Monad Zipper where
#if !(MIN_VERSION_base(4,11,0))
  return = repeat
#endif
  (Integer
z :~ Integer -> a
ma) >>= :: forall a b. Zipper a -> (a -> Zipper b) -> Zipper b
>>= a -> Zipper b
f = Integer
z forall a. Integer -> (Integer -> a) -> Zipper a
:~ \ Integer
na -> case a -> Zipper b
f (Integer -> a
ma Integer
na) of
    Integer
nb :~ Integer -> b
mb -> Integer -> b
mb (Integer
nb forall a. Num a => a -> a -> a
+ Integer
na forall a. Num a => a -> a -> a
- Integer
z)

repeat :: a -> Zipper a
repeat :: forall a. a -> Zipper a
repeat a
a = Integer
0 forall a. Integer -> (Integer -> a) -> Zipper a
:~ forall a b. a -> b -> a
const a
a

-- | Interleave two Zippers @xs@ and @ys@, alternating elements
-- from each list.
--
-- > [x1,x2,...] `interleave` [y1,y2,...] == [x1,y1,x2,y2,...]
-- > interleave = (<>)
interleave :: Zipper a -> Zipper a -> Zipper a
interleave :: forall a. Zipper a -> Zipper a -> Zipper a
interleave = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (Zipper a) where
  (Integer
n :~ Integer -> a
a) <> :: Zipper a -> Zipper a -> Zipper a
<> (Integer
m :~ Integer -> a
b) = Integer
0 forall a. Integer -> (Integer -> a) -> Zipper a
:~ \Integer
p -> case forall a. Integral a => a -> a -> (a, a)
quotRem Integer
p Integer
2 of
    (Integer
q, Integer
0) -> Integer -> a
a (Integer
n forall a. Num a => a -> a -> a
+ Integer
q)
    (Integer
q, Integer
_) -> Integer -> a
b (Integer
m forall a. Num a => a -> a -> a
+ Integer
q)

-- | @'intersperse' y xs@ creates an alternating stream of
-- elements from @xs@ and @y@.
intersperse :: a -> Zipper a -> Zipper a
intersperse :: forall a. a -> Zipper a -> Zipper a
intersperse a
y Zipper a
z = Zipper a
z forall a. Semigroup a => a -> a -> a
<> forall a. a -> Zipper a
repeat a
y

-- | 'transpose' computes the transposition of a stream of streams.
transpose :: Zipper (Zipper a) -> Zipper (Zipper a)
transpose :: forall a. Zipper (Zipper a) -> Zipper (Zipper a)
transpose (Integer
n :~ Integer -> Zipper a
f) = Integer
0 forall a. Integer -> (Integer -> a) -> Zipper a
:~ \Integer
z -> Integer
n forall a. Integer -> (Integer -> a) -> Zipper a
:~ \Integer
n' -> let Integer
m :~ Integer -> a
g = Integer -> Zipper a
f Integer
n' in Integer -> a
g (Integer
m forall a. Num a => a -> a -> a
+ Integer
z)

take :: Integer -> Zipper a -> [a]
take :: forall a. Integer -> Zipper a -> [a]
take Integer
n0 (Integer
m0 :~ Integer -> a
f0)
  | Integer
n0 forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"Zipper.take: negative argument"
  | Bool
otherwise = forall {t} {t} {a}.
(Eq t, Num t, Num t) =>
t -> t -> (t -> a) -> [a]
go Integer
n0 Integer
m0 Integer -> a
f0
  where
    go :: t -> t -> (t -> a) -> [a]
go t
0 !t
_ !t -> a
_ = []
    go t
n  t
m  t -> a
f = t -> a
f t
m forall a. a -> [a] -> [a]
: t -> t -> (t -> a) -> [a]
go (t
n forall a. Num a => a -> a -> a
- t
1) (t
m forall a. Num a => a -> a -> a
+ t
1) t -> a
f

-- | @'drop' n xs@ drops the first @n@ elements off the front of
-- the sequence @xs@.
drop :: Integer -> Zipper a -> Zipper a
drop :: forall a. Integer -> Zipper a -> Zipper a
drop Integer
m (Integer
n :~ Integer -> a
f) = Integer
m forall a. Num a => a -> a -> a
+ Integer
n forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f

-- | @'splitAt' n xs@ returns a pair consisting of the prefix of
-- @xs@ of length @n@ and the remaining stream immediately following
-- this prefix.
--
-- /Beware/: passing a negative integer as the first argument will
-- cause an error if you access the taken portion
splitAt :: Integer -> Zipper a -> ([a],Zipper a)
splitAt :: forall a. Integer -> Zipper a -> ([a], Zipper a)
splitAt Integer
n Zipper a
xs = (forall a. Integer -> Zipper a -> [a]
take Integer
n Zipper a
xs, forall a. Integer -> Zipper a -> Zipper a
drop Integer
n Zipper a
xs)

-- | @'takeWhile' p xs@ returns the longest prefix of the stream
-- @xs@ for which the predicate @p@ holds.
takeWhile :: (a -> Bool) -> Zipper a -> [a]
takeWhile :: forall a. (a -> Bool) -> Zipper a -> [a]
takeWhile a -> Bool
p0 (Integer
n0 :~ Integer -> a
f0) = forall {t} {a}. Num t => (a -> Bool) -> t -> (t -> a) -> [a]
go a -> Bool
p0 Integer
n0 Integer -> a
f0 where
  go :: (a -> Bool) -> t -> (t -> a) -> [a]
go !a -> Bool
p !t
n !t -> a
f
    | a
x <- t -> a
f t
n, a -> Bool
p a
x = a
x forall a. a -> [a] -> [a]
: (a -> Bool) -> t -> (t -> a) -> [a]
go a -> Bool
p (t
n forall a. Num a => a -> a -> a
+ t
1) t -> a
f
    | Bool
otherwise = []

-- | @'dropWhile' p xs@ returns the suffix remaining after
-- @'takeWhile' p xs@.
--
-- /Beware/: this function may diverge if every element of @xs@
-- satisfies @p@, e.g.  @dropWhile even (repeat 0)@ will loop.
dropWhile :: (a -> Bool) -> Zipper a -> Zipper a
dropWhile :: forall a. (a -> Bool) -> Zipper a -> Zipper a
dropWhile a -> Bool
p xs :: Zipper a
xs@(Integer
_ :~ Integer -> a
f) = forall a. (a -> Bool) -> Zipper a -> Integer
findIndex' a -> Bool
p Zipper a
xs forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f

-- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies
-- @p@, together with the remainder of the stream.
span :: (a -> Bool) -> Zipper a -> ([a], Zipper a)
span :: forall a. (a -> Bool) -> Zipper a -> ([a], Zipper a)
span a -> Bool
p0 (Integer
n0 :~ Integer -> a
f0)
  | ([a]
ts, Integer
n') <- forall {b} {a}. Num b => (a -> Bool) -> b -> (b -> a) -> ([a], b)
go a -> Bool
p0 Integer
n0 Integer -> a
f0 = ([a]
ts, Integer
n' forall a. Integer -> (Integer -> a) -> Zipper a
:~ Integer -> a
f0) where
  go :: (a -> Bool) -> b -> (b -> a) -> ([a], b)
go !a -> Bool
p !b
n !b -> a
f
    | a
x <- b -> a
f b
n, a -> Bool
p a
x, ([a]
ts, b
fs) <- (a -> Bool) -> b -> (b -> a) -> ([a], b)
go a -> Bool
p (b
n forall a. Num a => a -> a -> a
+ b
1) b -> a
f = (a
xforall a. a -> [a] -> [a]
:[a]
ts, b
fs)
    | Bool
otherwise = ([], b
n)

-- | The 'break' @p@ function is equivalent to 'span' @not . p@.
break :: (a -> Bool) -> Zipper a -> ([a], Zipper a)
break :: forall a. (a -> Bool) -> Zipper a -> ([a], Zipper a)
break a -> Bool
p = forall a. (a -> Bool) -> Zipper a -> ([a], Zipper a)
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

-- | The 'isPrefix' function returns @True@ if the first argument is
-- a prefix of the second.
isPrefixOf :: Eq a => [a] -> Zipper a -> Bool
isPrefixOf :: forall a. Eq a => [a] -> Zipper a -> Bool
isPrefixOf [a]
xs0 (Integer
n0 :~ Integer -> a
f0) = forall {a} {t}. (Eq a, Num t) => [a] -> t -> (t -> a) -> Bool
go [a]
xs0 Integer
n0 Integer -> a
f0 where
  go :: [a] -> t -> (t -> a) -> Bool
go [] !t
_ !t -> a
_ = Bool
True
  go (a
y:[a]
ys) t
n t -> a
f = a
y forall a. Eq a => a -> a -> Bool
== t -> a
f t
n Bool -> Bool -> Bool
&& [a] -> t -> (t -> a) -> Bool
go [a]
ys (t
n forall a. Num a => a -> a -> a
+ t
1) t -> a
f

-- | @xs !! n@ returns the element of the stream @xs@ at index
-- @n@. Note that the head of the stream has index 0.
(!!) :: Zipper a -> Integer -> a
!! :: forall a. Zipper a -> Integer -> a
(!!) (Integer
n :~ Integer -> a
f) Integer
m = Integer -> a
f (Integer
n forall a. Num a => a -> a -> a
+ Integer
m)

-- | The 'findIndex' function takes a predicate and a stream and returns
-- the index of the first element in the stream that satisfies the predicate,
--
-- /Beware/: 'findIndex' @p@ @xs@ will diverge if none of the elements of
-- @xs@ satisfy @p@.
findIndex :: (a -> Bool) -> Zipper a -> Integer
findIndex :: forall a. (a -> Bool) -> Zipper a -> Integer
findIndex a -> Bool
p0 (Integer
n0 :~ Integer -> a
f0) = forall {t} {t}. Num t => (t -> Bool) -> t -> (t -> t) -> t
go a -> Bool
p0 Integer
n0 Integer -> a
f0 forall a. Num a => a -> a -> a
- Integer
n0 where
  go :: (t -> Bool) -> t -> (t -> t) -> t
go !t -> Bool
p !t
n !t -> t
f
    | t
x <- t -> t
f t
n, t -> Bool
p t
x = t
n
    | Bool
otherwise = (t -> Bool) -> t -> (t -> t) -> t
go t -> Bool
p (t
n forall a. Num a => a -> a -> a
+ t
1) t -> t
f

-- | Internal helper, used to find an index in the
findIndex' :: (a -> Bool) -> Zipper a -> Integer
findIndex' :: forall a. (a -> Bool) -> Zipper a -> Integer
findIndex' a -> Bool
p0 (Integer
n0 :~ Integer -> a
f0) = forall {t} {t}. Num t => (t -> Bool) -> t -> (t -> t) -> t
go a -> Bool
p0 Integer
n0 Integer -> a
f0 where
  go :: (t -> Bool) -> t -> (t -> t) -> t
go !t -> Bool
p !t
n !t -> t
f
    | t
x <- t -> t
f t
n, t -> Bool
p t
x = t
n
    | Bool
otherwise = (t -> Bool) -> t -> (t -> t) -> t
go t -> Bool
p (t
n forall a. Num a => a -> a -> a
+ t
1) t -> t
f

-- | The 'elemIndex' function returns the index of the first element
-- in the given stream which is equal (by '==') to the query element,
--
-- /Beware/: @'elemIndex' x xs@ will diverge if none of the elements
-- of @xs@ equal @x@.
elemIndex :: Eq a => a -> Zipper a -> Integer
elemIndex :: forall a. Eq a => a -> Zipper a -> Integer
elemIndex = forall a. (a -> Bool) -> Zipper a -> Integer
findIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)

{-
-- | The 'elemIndices' function extends 'elemIndex', by returning the
-- indices of all elements equal to the query element, in ascending order.
--
-- /Beware/: 'elemIndices' @x@ @xs@ will diverge if any suffix of
-- @xs@ does not contain @x@.
elemIndices :: Eq a => a -> Zipper a -> Zipper Int
elemIndices x = findIndices (x==)
-}

-- | The 'zip' function takes two streams and returns a list of
-- corresponding pairs.
--
-- > zip = liftA2 (,)
zip :: Zipper a -> Zipper b -> Zipper (a,b)
zip :: forall a b. Zipper a -> Zipper b -> Zipper (a, b)
zip = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)

-- | The 'zipWith' function generalizes 'zip'. Rather than tupling
-- the functions, the elements are combined using the function
-- passed as the first argument to 'zipWith'.
--
-- > zipWith = liftA2
zipWith :: (a -> b -> c) -> Zipper a -> Zipper b -> Zipper c
zipWith :: forall a b c. (a -> b -> c) -> Zipper a -> Zipper b -> Zipper c
zipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2

-- | The 'unzip' function is the inverse of the 'zip' function.
unzip :: Zipper (a,b) -> (Zipper a, Zipper b)
unzip :: forall a b. Zipper (a, b) -> (Zipper a, Zipper b)
unzip Zipper (a, b)
xs = (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper (a, b)
xs, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper (a, b)
xs)



{-

-- | The 'findIndices' function extends 'findIndex', by returning the
-- indices of all elements satisfying the predicate, in ascending
-- order.
--
-- /Beware/: 'findIndices' @p@ @xs@ will diverge if all the elements
-- of any suffix of @xs@ fails to satisfy @p@.
findIndices :: (a -> Bool) -> Zipper a -> Zipper Int
findIndices p = indicesFrom 0 where
  indicesFrom ix (x :< xs)
    | p x = ix :< ixs
    | otherwise = ixs
    where ixs = (indicesFrom $! (ix+1)) xs


-- | The 'words' function breaks a stream of characters into a
-- stream of words, which were delimited by white space.
--
-- /Beware/: if the stream of characters @xs@ does not contain white
-- space, accessing the tail of @words xs@ will loop.
words :: Zipper Char -> Zipper String
words xs | (w, ys) <- break isSpace xs = w :< words ys

-- | The 'unwords' function is an inverse operation to 'words'. It
-- joins words with separating spaces.
unwords :: Zipper String -> Zipper Char
unwords ~(x :< xs) = foldr (:<) (' ' :< unwords xs) x

-- | The 'lines' function breaks a stream of characters into a list
-- of strings at newline characters. The resulting strings do not
-- contain newlines.
--
-- /Beware/: if the stream of characters @xs@ does not contain
-- newline characters, accessing the tail of @lines xs@ will loop.
lines :: Zipper Char -> Zipper String
lines xs | (l, ys) <- break (== '\n') xs = l :< lines (tail ys)

-- | The 'unlines' function is an inverse operation to 'lines'. It
-- joins lines, after appending a terminating newline to each.
unlines :: Zipper String -> Zipper Char
unlines ~(x :< xs) = foldr (:<) ('\n' :< unlines xs) x

-- | The 'fromList' converts an infinite list to a
-- stream.
--
-- /Beware/: Passing a finite list, will cause an error.
fromList :: [a] -> Zipper a
fromList (x:xs) = x :< fromList xs
fromList []     = error "Zipper.listToZipper applied to finite list"

-}