Compose Streams
module Main where | |
import Prelude | |
import TryPureScript | |
import Control.Comonad.Cofree (Cofree, head, mkCofree, tail, unfoldCofree) | |
import Control.Monad.Eff (Eff) | |
import Control.Monad.Eff.Console (CONSOLE, log) | |
import Control.Monad.Eff.Unsafe (unsafePerformEff) | |
import Data.Array (fromFoldable) | |
import Data.Foldable (fold) | |
import Data.Identity (Identity(..)) | |
import Data.List (List(..), (:)) | |
import Data.Tuple (Tuple(..), uncurry) | |
import Unsafe.Coerce (unsafeCoerce) | |
data FIdentity a = FIdentity a | End | |
derive instance functorFIdentity :: Functor FIdentity | |
instance eqFIdentity :: (Eq a) => Eq (FIdentity a) where | |
eq (FIdentity a) (FIdentity b) = a == b | |
eq End End = true | |
eq _ _ = false | |
composeWith | |
:: forall f g h a b c | |
. Functor f | |
=> Functor g | |
=> Functor h | |
=> (a -> b -> c) | |
-> (Cofree f a -> Cofree g b -> f (Cofree f a) -> g (Cofree g b) -> h (Tuple (Cofree f a) (Cofree g b))) | |
-> Cofree f a | |
-> Cofree g b | |
-> Cofree h c | |
composeWith zap zapTail f g = | |
mkCofree | |
(zap (head f) (head g)) | |
(fn (tail f) (tail g)) | |
where | |
fn :: f (Cofree f a) -> g (Cofree g b) -> h (Cofree h c) | |
fn fa gb = uncurry (composeWith zap zapTail) <$> zapTail f g fa gb | |
fibStream :: Cofree FIdentity Int | |
fibStream = gen next 0 | |
where | |
next :: Int -> Int -> FIdentity Int | |
next a b | a > 1000 = End | |
| otherwise = FIdentity $ a + b | |
gen | |
:: (Int -> Int -> FIdentity Int) | |
-> Int | |
-> Cofree FIdentity Int | |
gen n a = mkCofree a (gen n <$> n a (a + 1)) | |
composedStream :: Cofree FIdentity (Tuple Int Int) | |
composedStream = composeWith Tuple fn fibStream fibStream | |
where | |
fn _ _ (FIdentity c1) (FIdentity c2) = FIdentity (Tuple c1 c2) | |
fn _ _ _ _ = End | |
toList :: forall a. Cofree FIdentity a -> List a | |
toList c = case tail c of | |
End -> head c : Nil | |
FIdentity c' -> head c : toList c' | |
main = do | |
render $ fold $ | |
[ h1 (text "Compose Streams") | |
, p $ code $ text $ show $ fromFoldable $ toList composedStream | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment