Skip to content

Instantly share code, notes, and snippets.

Sjoerd Visscher sjoerdvisscher

Block or report user

Report or block sjoerdvisscher

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
@sjoerdvisscher
sjoerdvisscher / CatTagged.hs
Last active Jan 3, 2019
Kind-indexed categories with kind-tagging
View CatTagged.hs
{-# LANGUAGE
GADTs
, MultiParamTypeClasses
, RankNTypes
, TypeApplications
, TypeFamilies
, TypeOperators
, PolyKinds
, DataKinds
, InstanceSigs
@sjoerdvisscher
sjoerdvisscher / SuffixTree.hs
Created Dec 15, 2018
Suffix trees are united monoids
View SuffixTree.hs
{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}
import qualified Data.Map as M
import Data.List
import Data.String
import Data.Functor
newtype SuffixTree a = ST (M.Map a (SuffixTree a)) deriving (Eq, Ord)
instance Ord a => Semigroup (SuffixTree a) where
View monoidComprehensions.hs
{-# LANGUAGE MonadComprehensions, RebindableSyntax #-}
import Prelude hiding (return, (>>=), (>>), guard)
return :: a -> a
return = id
(>>=) :: (Foldable f, Monoid m) => f a -> (a -> m) -> m
(>>=) = flip foldMap
guard :: Bool -> Bool
View algebra-sum.hs
{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, ConstraintKinds, UndecidableSuperClasses #-}
import GHC.Generics
import Data.Algebra
class (a x, b x) => (a + b) x
instance (a x, b x) => (a + b) x
type instance Signature (a + b) = Signature a :+: Signature b
instance (AlgebraSignature f, AlgebraSignature g) => AlgebraSignature (f :+: g) where
View coerceDict.hs
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
View gvalidate.hs
{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeApplications, MultiParamTypeClasses, GADTs #-}
import Generics.OneLiner.Binary
import Data.Functor.Identity
class IsMaybe s s' where isMaybe :: s -> Maybe s'
instance (s ~ Maybe s') => IsMaybe s s' where isMaybe = id
validate
:: (ADT (f Maybe) (f Identity), Constraints (f Maybe) (f Identity) IsMaybe)
@sjoerdvisscher
sjoerdvisscher / laws.hs
Last active Jul 24, 2018
First class checkable laws using the free-functors package
View laws.hs
{-# LANGUAGE
TypeFamilies
, KindSignatures
, ScopedTypeVariables
, ConstraintKinds
, FlexibleInstances
, FlexibleContexts
, DeriveGeneric
, DeriveAnyClass
, TypeApplications
View hfree example.hs
{-# LANGUAGE TypeFamilies, FlexibleInstances, FlexibleContexts, RankNTypes, GADTs, TypeOperators, UndecidableInstances, ConstraintKinds, DataKinds , ScopedTypeVariables #-}
import Data.Constraint
import Data.Constraint.Class1
import Data.Functor.HFree
class BaseSem sem where
val :: a -> sem a
add :: sem Int -> sem Int -> sem Int
View basesem2.hs
{-# LANGUAGE TypeFamilies, FlexibleInstances, RankNTypes, GADTs #-}
class BaseSem sem where
val :: a -> sem a
add :: sem Int -> sem Int -> sem Int
iff :: sem Bool -> sem a -> sem a -> sem a
gte :: sem Int -> sem Int -> sem Bool
expr :: BaseSem sem => sem Int
expr = iff (gte (val 10) (val 20)) (val 100) (val 200)
View basesem.hs
{-# LANGUAGE TypeFamilies, FlexibleInstances, RankNTypes, GADTs #-}
import Data.Functor.HFree
class BaseSem sem where
val :: a -> sem a
add :: sem Int -> sem Int -> sem Int
iff :: sem Bool -> sem a -> sem a -> sem a
gte :: sem Int -> sem Int -> sem Bool
You can’t perform that action at this time.