Skip to content

Instantly share code, notes, and snippets.

@cryogenian
Created February 10, 2017 14:30
Show Gist options
  • Save cryogenian/ab8bfa8600595efff64850a0758c5bb9 to your computer and use it in GitHub Desktop.
Save cryogenian/ab8bfa8600595efff64850a0758c5bb9 to your computer and use it in GitHub Desktop.
newtype HalogenM s (f :: * -> *) g p o m a = HalogenM (Free (HalogenF s f g p o m) a)
data HalogenR (r ∷ # *) a
class RowEquals (a ∷ # *) (b ∷ # *) | a → b, b → a where
toR ∷ ∀ p. p a → p b
fromR ∷ ∀ p. p b → p a
instance refl ∷ RowEquals r r where
toR = id
fromR = id
class TypeEquals a b | a → b, b → a where
to ∷ a → b
from ∷ b → a
instance halogenRIsEqualFree ∷ RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit|rr) ⇒ TypeEquals (HalogenR r a) (Free (HalogenF s f g p o m) a) where
to = unsafeCoerce
from = unsafeCoerce
instance functorHalogenR ∷ RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit |rr) ⇒ Functor (HalogenR r) where
map f hr = from $ map f $ to hr
instance applyHalogenR ∷ RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit |rr) ⇒ Apply (HalogenR r) where
apply f w = from $ apply (to f) (to w)
instance applicativeHalogenR ∷ RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit|rr) ⇒ Applicative (HalogenR r) where
pure a = from $ pure a
instance bindHalogenR ∷ RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit|rr) ⇒ Bind (HalogenR r) where
bind rfa rf = from $ to rfa >>= \x → to $ rf x
instance monadHalogenR ∷ RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit|rr) ⇒ Monad (HalogenR r)
instance monadEffHalogenR ∷ (RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit|rr), MonadEff eff m) ⇒ MonadEff eff (HalogenR r) where
liftEff eff = from $ liftF $ Lift $ liftEff eff
instance monadAffHalogenR ∷ (RowEquals r (state ∷ s, query ∷ f Unit, childQuery ∷ g Unit, childSlot ∷ p, output ∷ o, effect ∷ m Unit|rr), MonadAff eff m) ⇒ MonadAff eff (HalogenR r) where
liftAff aff = from $ liftF $ Lift $ liftAff aff
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment