GrateExample.purs

module Main where

import Prelude

import Control.Comonad
import Control.Lazy
import Data.Array ((:))
import Data.Distributive
import Data.Lens.Grate
import Data.Lens
import Data.Pair
import Data.Tuple
import Effect (Effect)
import Effect.Console (log, logShow)
import Data.Pair

data Stream a = Cons a (Unit -> Stream a)

instance functorStream :: Functor Stream where
  map f (Cons x k) = Cons (f x) (map f <<< k)

instance extendStream :: Extend Stream where
  extend f w = Cons (f w) (\_ -> extend f (tail w))

instance comonadStream :: Comonad Stream where
  extract = head

instance distributiveStream :: Distributive Stream where
  distribute w = Cons (map extract w) (\_ -> distribute (map tail w))
  collect f = distribute <<< map f

data Tape a = Tape  {  viewL  :: Stream a
                    ,  focus  :: a
                    ,  viewR  :: Stream a
                    }

instance functorTape :: Functor Tape

instance extendTape :: Extend Tape

instance comonadTape :: Comonad Tape where
  extract = focus

unfold  ::  (c -> Tuple a c)  -- leftwards unfolding function
        ->  (c -> a)      -- function from seed to focus value
        ->  (c -> Tuple a c)  -- rightwards unfolding function
        ->  c             -- seed
        ->  Tape a
unfold prev center next seed =
   Tape  (Stream.unfold prev seed)
         (center seed)
         (Stream.unfold next seed)

instance distributiveTape :: Distributive Tape where
   distribute =
      unfold  (fmap (extract . moveL) &&& fmap moveL)
              (fmap extract)
              (fmap (extract . moveR) &&& fmap moveR)




iota :: Stream Int
iota = Cons 1 \_ -> map (_ + 1) iota

iota2 :: Stream (Pair Int)
iota2 = Cons (Pair 1 2) \_ -> map (\(Pair x y) -> Pair (x + 2) (y + 2)) iota2

repeat :: Int -> Stream Int
repeat x = Cons x \_ -> repeat x

head :: forall a. Stream a -> a
head (Cons x xs) = x

tail :: forall a. Stream a -> Stream a
tail (Cons x xs) = xs unit

take :: forall a. Int -> Stream a -> Array a
take 0 xs = []
take n (Cons x xs) = x : take (n - 1) (xs unit)

aGraterExample :: forall a. Grate (Stream a) (Stream Int) a Int
aGraterExample = grate \f -> repeat (f head)

summing :: Pair Int -> Pair Int -> Pair Int
summing = zipWithOf (cotraversed) (+)

summing' :: Stream Int -> Stream Int -> Stream Int
-- summing' = zipWithOf (cloneGrate aGraterExample) (+)
summing' = zipWithOf cotraversed (+)

main :: Effect Unit
main = do
  log $ show $ take 5 $ iota
  logShow (take 5 $ zipWithOf (cotraversed <<< cotraversed) (+) iota2 iota2)
  logShow (zipWithOf cotraversed (+) (Pair 1 2) (Pair 3 4))
  -- logShow (take 5 $ over summing' (_+2) iota iota)