Skip to content

Instantly share code, notes, and snippets.

@coot
Last active June 29, 2017 09:47
Show Gist options
  • Save coot/6bac5a9839403f65c40e8494031c9a00 to your computer and use it in GitHub Desktop.
Save coot/6bac5a9839403f65c40e8494031c9a00 to your computer and use it in GitHub Desktop.
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