{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UnboxedTuples         #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Trifecta.Util.It
-- Copyright   :  (C) 2011-2019 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- harder, better, faster, stronger...
----------------------------------------------------------------------------
module Text.Trifecta.Util.It
  ( It(Pure, It)
  , needIt
  , wantIt
  , simplifyIt
  , foldIt
  , runIt
  , fillIt
  , rewindIt
  , sliceIt
  ) where

import Control.Comonad
import Control.Monad

import Data.ByteString                as Strict
import Data.ByteString.Lazy           as Lazy
import Data.Profunctor
import Text.Trifecta.Delta
import Text.Trifecta.Rope
import Text.Trifecta.Util.Combinators as Util

-- $setup
-- >>> import Control.Comonad (extract)
-- >>> import Data.ByteString as Strict
-- >>> import Text.Trifecta.Delta
-- >>> import Text.Trifecta.Rope
-- >>> import Text.Trifecta.Util.It

-- | @'It'@ is an <https://wiki.haskell.org/Enumerator_and_iteratee Iteratee>
-- that can produce partial results.
--
-- @'It' r a@ consumes a feed of @r@s and produces @a@s on the way. New values
-- can be fed using @'simplifyIt'@, the current (partial or final) result is
-- extracted using @'extract'@.
--
-- >>> let keepIt    a = Pure a
-- >>> let replaceIt a = It a replaceIt
--
-- >>> extract (keepIt 0)
-- 0
--
-- >>> extract (replaceIt 0)
-- 0
--
-- >>> extract (simplifyIt (keepIt 0) 5)
-- 0
--
-- >>> extract (simplifyIt (replaceIt 0) 5)
-- 5
data It r a
  = Pure a
  -- ^ Final result, rest of the feed is discarded
  | It a (r -> It r a)
  -- ^ Intermediate result, consumed values produce new results

instance Show a => Show (It r a) where
  showsPrec :: Int -> It r a -> ShowS
showsPrec Int
d (Pure a
a) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Pure " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
  showsPrec Int
d (It a
a r -> It r a
_) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"It " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ..."

instance Functor (It r) where
  fmap :: forall a b. (a -> b) -> It r a -> It r b
fmap a -> b
f (Pure a
a) = forall r a. a -> It r a
Pure forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
  fmap a -> b
f (It a
a r -> It r a
k) = forall r a. a -> (r -> It r a) -> It r a
It (a -> b
f a
a) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> It r a
k

instance Profunctor It where
  rmap :: forall b c a. (b -> c) -> It a b -> It a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  lmap :: forall a b c. (a -> b) -> It b c -> It a c
lmap a -> b
_ (Pure c
a) = forall r a. a -> It r a
Pure c
a
  lmap a -> b
f (It c
a b -> It b c
g) = forall r a. a -> (r -> It r a) -> It r a
It c
a (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> It b c
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Applicative (It r) where
  pure :: forall a. a -> It r a
pure = forall r a. a -> It r a
Pure
  Pure a -> b
f  <*> :: forall a b. It r (a -> b) -> It r a -> It r b
<*> Pure a
a  = forall r a. a -> It r a
Pure forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
  Pure a -> b
f  <*> It a
a r -> It r a
ka = forall r a. a -> (r -> It r a) -> It r a
It (a -> b
f a
a) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> It r a
ka
  It a -> b
f r -> It r (a -> b)
kf <*> Pure a
a  = forall r a. a -> (r -> It r a) -> It r a
It (a -> b
f a
a) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> It r (a -> b)
kf
  It a -> b
f r -> It r (a -> b)
kf <*> It a
a r -> It r a
ka = forall r a. a -> (r -> It r a) -> It r a
It (a -> b
f a
a) forall a b. (a -> b) -> a -> b
$ \r
r -> r -> It r (a -> b)
kf r
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> It r a
ka r
r

indexIt :: It r a -> r -> a
indexIt :: forall r a. It r a -> r -> a
indexIt (Pure a
a) r
_ = a
a
indexIt (It a
_ r -> It r a
k) r
r = forall (w :: * -> *) a. Comonad w => w a -> a
extract (r -> It r a
k r
r)

-- | Feed a value to 'It', obtaining a new (partial or final) result.
simplifyIt :: It r a -> r -> It r a
simplifyIt :: forall r a. It r a -> r -> It r a
simplifyIt (It a
_ r -> It r a
k) r
r = r -> It r a
k r
r
simplifyIt It r a
pa r
_       = It r a
pa

instance Monad (It r) where
  return :: forall a. a -> It r a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Pure a
a >>= :: forall a b. It r a -> (a -> It r b) -> It r b
>>= a -> It r b
f = a -> It r b
f a
a
  It a
a r -> It r a
k >>= a -> It r b
f = forall r a. a -> (r -> It r a) -> It r a
It (forall (w :: * -> *) a. Comonad w => w a -> a
extract (a -> It r b
f a
a)) forall a b. (a -> b) -> a -> b
$ \r
r -> case r -> It r a
k r
r of
    It a
a' r -> It r a
k' -> forall r a. a -> (r -> It r a) -> It r a
It (forall r a. It r a -> r -> a
indexIt (a -> It r b
f a
a') r
r) forall a b. (a -> b) -> a -> b
$ r -> It r a
k' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> It r b
f
    Pure a
a' -> forall r a. It r a -> r -> It r a
simplifyIt (a -> It r b
f a
a') r
r

instance ComonadApply (It r) where <@> :: forall a b. It r (a -> b) -> It r a -> It r b
(<@>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

-- | 'It' is a cofree comonad
instance Comonad (It r) where
  duplicate :: forall a. It r a -> It r (It r a)
duplicate p :: It r a
p@Pure{}   = forall r a. a -> It r a
Pure It r a
p
  duplicate p :: It r a
p@(It a
_ r -> It r a
k) = forall r a. a -> (r -> It r a) -> It r a
It It r a
p (forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> It r a
k)

  extend :: forall a b. (It r a -> b) -> It r a -> It r b
extend It r a -> b
f p :: It r a
p@Pure{}   = forall r a. a -> It r a
Pure (It r a -> b
f It r a
p)
  extend It r a -> b
f p :: It r a
p@(It a
_ r -> It r a
k) = forall r a. a -> (r -> It r a) -> It r a
It (It r a -> b
f It r a
p) (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend It r a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> It r a
k)

  extract :: forall a. It r a -> a
extract (Pure a
a) = a
a
  extract (It a
a r -> It r a
_) = a
a

-- | Consumes input until a value can be produced.
--
-- >>> :{
-- let needTen = needIt 0 (\n -> if n < 10 then Nothing else Just n) :: It Int Int
-- :}
--
-- >>> extract needTen
-- 0
--
-- >>> extract (simplifyIt needTen 5)
-- 0
--
-- >>> extract (simplifyIt needTen 11)
-- 11
--
-- >>> extract (simplifyIt (simplifyIt (simplifyIt needTen 5) 11) 15)
-- 11
needIt
    :: a               -- ^ Initial result
    -> (r -> Maybe a)  -- ^ Produce a result if possible
    -> It r a
needIt :: forall a r. a -> (r -> Maybe a) -> It r a
needIt a
z r -> Maybe a
f = It r a
k where
  k :: It r a
k = forall r a. a -> (r -> It r a) -> It r a
It a
z forall a b. (a -> b) -> a -> b
$ \r
r -> case r -> Maybe a
f r
r of
    Just a
a -> forall r a. a -> It r a
Pure a
a
    Maybe a
Nothing -> It r a
k

-- | Consumes input and produces partial results until a condition is met.
-- Unlike 'needIt', partial results are already returned when the condition is
-- not fulfilled yet.
--
-- > >>> :{
-- > let wantTen :: It Int Int
-- >     wantTen = wantIt 0 (\n -> (# n >= 10, n #))
-- > :}
--
-- > >>> extract wantTen
-- > 0
--
-- > >>> extract (simplifyIt wantTen 5)
-- > 5
--
-- > >>> extract (simplifyIt wantTen 11)
-- > 11
--
-- > >>> extract (simplifyIt (simplifyIt (simplifyIt wantTen 5) 11) 15)
-- > 11
wantIt
    :: a                 -- ^ Initial result
    -> (r -> (# Bool, a #))  -- ^ Produce a partial or final result
    -> It r a
wantIt :: forall a r. a -> (r -> (# Bool, a #)) -> It r a
wantIt a
z r -> (# Bool, a #)
f = forall r a. a -> (r -> It r a) -> It r a
It a
z r -> It r a
k where
  k :: r -> It r a
k r
r = case r -> (# Bool, a #)
f r
r of
    (# Bool
False, a
a #) -> forall r a. a -> (r -> It r a) -> It r a
It a
a r -> It r a
k
    (# Bool
True,  a
a #) -> forall r a. a -> It r a
Pure a
a

-- | The generalized fold (Böhm-Berarducci decoding) over 'It r a'.
--
-- 'foldIt' satisfies the property:
--
-- @foldIt Pure It = id@
foldIt :: (a -> o) -> (a -> (r -> o) -> o) -> It r a -> o
foldIt :: forall a o r. (a -> o) -> (a -> (r -> o) -> o) -> It r a -> o
foldIt a -> o
p a -> (r -> o) -> o
_ (Pure a
a) = a -> o
p a
a
foldIt a -> o
p a -> (r -> o) -> o
i (It a
a r -> It r a
k) = a -> (r -> o) -> o
i a
a (\r
r -> forall a o r. (a -> o) -> (a -> (r -> o) -> o) -> It r a -> o
foldIt a -> o
p a -> (r -> o) -> o
i (r -> It r a
k r
r))

-- | Scott decoding of 'It r a'.
--
-- The scott decoding is similar to the generalized fold over a data type, but
-- leaves the recursion step to the calling function.
--
-- 'runIt' satiesfies the property:
--
-- @runIt Pure It = id@
--
-- See also the Scott decoding of lists:
--
-- @runList :: (a -> [a] -> b) -> b -> [a] -> b@
--
-- and compare it with 'foldr' (the Böhm-Berarducci decoding for lists):
--
-- @foldr :: (a -> b -> b) -> b -> [a] -> b@
runIt :: (a -> o) -> (a -> (r -> It r a) -> o) -> It r a -> o
runIt :: forall a o r. (a -> o) -> (a -> (r -> It r a) -> o) -> It r a -> o
runIt a -> o
p a -> (r -> It r a) -> o
_ (Pure a
a) = a -> o
p a
a
runIt a -> o
_ a -> (r -> It r a) -> o
i (It a
a r -> It r a
k) = a -> (r -> It r a) -> o
i a
a r -> It r a
k

-- * Rope specifics

-- | Given a position, go there, and grab the rest of the line forward from that
-- point.
--
-- >>> :set -XOverloadedStrings
-- >>> let secondLine = fillIt Nothing (const Just) (delta ("foo\nb" :: Strict.ByteString))
--
-- >>> extract secondLine
-- Nothing
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo"))
-- Nothing
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo\nbar"))
-- Just "ar"
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo\nbar\nbaz"))
-- Just "ar\n"
fillIt :: r -> (Delta -> Strict.ByteString -> r) -> Delta -> It Rope r
fillIt :: forall r. r -> (Delta -> ByteString -> r) -> Delta -> It Rope r
fillIt r
kf Delta -> ByteString -> r
ks Delta
n = forall a r. a -> (r -> (# Bool, a #)) -> It r a
wantIt r
kf forall a b. (a -> b) -> a -> b
$ \Rope
r ->
  (# forall t. HasBytes t => t -> Int64
bytes Delta
n forall a. Ord a => a -> a -> Bool
< forall t. HasBytes t => t -> Int64
bytes (Delta -> Delta
rewind (forall t. HasDelta t => t -> Delta
delta Rope
r))
  ,  forall r. Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabLine Delta
n Rope
r r
kf Delta -> ByteString -> r
ks #)

-- | Return the text of the line that contains a given position
--
-- >>> :set -XOverloadedStrings
-- >>> let secondLine = rewindIt (delta ("foo\nb" :: Strict.ByteString))
--
-- >>> extract secondLine
-- Nothing
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo"))
-- Nothing
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo\nbar"))
-- Just "bar"
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo\nbar\nbaz"))
-- Just "bar\n"
rewindIt :: Delta -> It Rope (Maybe Strict.ByteString)
rewindIt :: Delta -> It Rope (Maybe ByteString)
rewindIt Delta
n = forall a r. a -> (r -> (# Bool, a #)) -> It r a
wantIt forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \Rope
r ->
  (# forall t. HasBytes t => t -> Int64
bytes Delta
n forall a. Ord a => a -> a -> Bool
< forall t. HasBytes t => t -> Int64
bytes (Delta -> Delta
rewind (forall t. HasDelta t => t -> Delta
delta Rope
r))
  ,  forall r. Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabLine (Delta -> Delta
rewind Delta
n) Rope
r forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> Maybe a
Just #)

-- | Return the text between two offsets.
--
-- >>> :set -XOverloadedStrings
-- >>> let secondLine = sliceIt (delta ("foo\n" :: Strict.ByteString)) (delta ("foo\nbar\n" :: Strict.ByteString))
--
-- >>> extract secondLine
-- ""
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo"))
-- ""
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo\nbar"))
-- "bar"
--
-- >>> extract (simplifyIt secondLine (ropeBS "foo\nbar\nbaz"))
-- "bar\n"
sliceIt :: Delta -> Delta -> It Rope Strict.ByteString
sliceIt :: Delta -> Delta -> It Rope ByteString
sliceIt !Delta
i !Delta
j = forall a r. a -> (r -> (# Bool, a #)) -> It r a
wantIt forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ \Rope
r ->
  (# Int64
bj forall a. Ord a => a -> a -> Bool
< forall t. HasBytes t => t -> Int64
bytes (Delta -> Delta
rewind (forall t. HasDelta t => t -> Delta
delta Rope
r))
  ,  forall r. Delta -> Rope -> r -> (Delta -> ByteString -> r) -> r
grabRest Delta
i Rope
r forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Util.fromLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
Lazy.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
bj forall a. Num a => a -> a -> a
- Int64
bi)) #)
  where
    bi :: Int64
bi = forall t. HasBytes t => t -> Int64
bytes Delta
i
    bj :: Int64
bj = forall t. HasBytes t => t -> Int64
bytes Delta
j