Skip to content

Instantly share code, notes, and snippets.

Denis Stoyanov xgrommx

Block or report user

Report or block xgrommx

Hide content and notifications from this user.

Learn more about blocking users

Contact Support about this user’s behavior.

Learn more about reporting abuse

Report abuse
View GitHub Profile
View hiso.hs
import Data.Functor.Day
import Data.Functor.Identity
import Data.Functor.Compose
import Data.Profunctor.Composition
import Data.Profunctor.Yoneda
import Data.Profunctor
import Control.Monad
import Control.Applicative
import qualified Control.Category as C
import qualified Control.Arrow as A
@xgrommx
xgrommx / LensEADT.purs
Created Sep 10, 2019
EADT with profunctor lenses and prisms
View LensEADT.purs
module Main where
import Prelude
import Control.Lazy (fix)
import Control.MonadZero (guard, (<|>))
import Data.Foldable (oneOfMap)
import Data.Functor.Mu (Mu, roll, unroll)
import Data.Functor.Variant (VariantF)
import Data.Functor.Variant as VF
View LensExample.purs
module LensExample where
import Prelude
import Data.Array (filter)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens (Traversal, traversed, wander, (.~), (^..), (+~))
import Data.Traversable (traverse)
import Effect (Effect)
View FAlgebra.purs
data Append t = Append t t
derive instance functorAppend :: Functor Append
type Semigroup' r = (append :: V.FProxy Append | r)
newtype Semigroup t = Semigroup (V.VariantF (Semigroup' ()) t)
derive instance functorSemigroup :: Functor Semigroup
_append = SProxy :: SProxy "append"
append :: forall a. Algebra Semigroup a => a -> a -> a
View hetero.purs
newtype Circle = Circle { circleRadius :: Number, circleCenter :: Tuple Number Number }
derive instance genericCircle :: Generic Circle _
instance showCircle :: Show Circle where
show c = genericShow c
instance eqCircle :: Eq Circle where
eq x y = genericEq x y
View muv.purs
type MuV t = Mu (VariantF t)
inv :: forall a b f s. RowCons s (FProxy f) a b
=> IsSymbol s
=> Functor f
=> SProxy s
-> f (Mu (VariantF b))
-> Mu (VariantF b)
inv x = In <<< (inj x)
View metamorphism.hs
-- | A “flushing” 'stream', with an additional coalgebra for flushing the
-- remaining values after the input has been consumed. This also allows us to
-- generalize the output away from lists.
fstream
:: (Cursive t (XNor a), Cursive u f, Corecursive u f, Traversable f)
=> Coalgebra f b -> (b -> a -> b) -> Coalgebra f b -> b -> t -> u
fstream ψ g ψ' = go
where
go c x =
let fb = ψ c
@xgrommx
xgrommx / tree.purs
Created Feb 28, 2018
Recursion schemes (derive Functor/Traversable/Foldable via catamorphism and Bifunctor/Bitraversable/Bifoldable)
View tree.purs
module Tree where
import Control.Monad.Writer
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Foldable
import Data.Generic
import Data.Monoid
import Data.Monoid.Additive
@xgrommx
xgrommx / streams.hs
Created Jan 19, 2018 — forked from michaelt/streams.hs
little streaming library
View streams.hs
{-#LANGUAGE BangPatterns #-}
import GHC.Magic
import Data.IORef
import Control.Monad
import Control.Monad.Trans
data Stream a m r = Yield a (Stream a m r) | Done r | Delay (() -> m (Stream a m r))
instance Functor m => Functor (Stream a m) where
fmap f (Done r) = Done (f r)
View HRecursionSchemes.hs
{-# LANGUAGE StandaloneDeriving, DataKinds, PolyKinds, GADTs, RankNTypes, TypeOperators, FlexibleContexts, TypeFamilies, KindSignatures #-}
-- http://www.timphilipwilliams.com/posts/2013-01-16-fixing-gadts.html
module HRecursionSchemes where
import Control.Applicative
import Data.Functor.Identity
import Data.Functor.Const
import Text.PrettyPrint.Leijen hiding ((<>))
You can’t perform that action at this time.