View Rollable.hs
{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DefaultSignatures, DeriveAnyClass, DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators #-}
module Rollable where
import Data.Functor.Foldable
import GHC.Generics
data Tree = Empty | Node Tree Int Tree
deriving (Eq, Generic, Ord, Rollable, Show)
depth :: Tree -> Int
View ParameterizedRecursion.hs
module ParameterizedRecursion where
import Data.Function
-- A recursive function…
showTable :: (Show a, Show b) => [(a, b)] -> String
showTable ((a, b) : rest) = show a ++ " | " ++ show b ++ "\n" ++ showTable rest
showTable [] = ""
-- …can be defined instead as a fixpoint…
View SES.hs
dyna :: Functor f => (f (Cofree f a) -> a) -> (c -> f c) -> c -> a
dyna a c = extract . h
where h = cofree . uncurry (:<) . (a &&& identity) . fmap h . c
ses :: Eq a => [a] -> [a] -> [These a a]
ses as bs = dyna (selectBest . edges (length as)) (editGraph as) (as, bs)
-- | A vertex in the edit graph.
data Vertex a x = Vertex { xs :: [a], ys :: [a], next :: Maybe x }
deriving (Eq, Functor, Show)
View Constructor.hs
{-# LANGUAGE DefaultSignatures, DeriveAnyClass, StandaloneDeriving, TypeFamilies, TypeOperators #-}
module Constructor where
import Data.Function (on)
import GHC.Generics
import Prologue
-- | The class of types for which we can determine whether an inhabitant was constructed with some specific constructor.
-- Note that the provided instance for functions returning 'HasConstructor' types, @HasConstructor b => HasConstructor (a -> b)@, applies its first argument to 'undefined'. Thus, data types with strict fields cannot safely implement 'HasConstructor' instances, since they would diverge. If you really want to play with fire, then you’ll have to apply the constructors to any strict fields yourself on the left-hand side.
View Bidi.hs
{-# LANGUAGE DeriveFunctor #-}
module Bidi where
-- For 'guard'.
import Control.Monad
-- We use Cofree to represent type-annotated terms.
import Control.Comonad.Cofree
import Data.Functor.Classes
-- We use Fix to represent unannotated terms.
import Data.Functor.Foldable
View JoinMonoid.hs
import Data.Maybe
import Data.Monoid
-- | Join a Foldable collection of Monoids by a separator element.
join :: (Monoid a, Foldable t) => a -> t a -> a
join sep = fromMaybe mempty . fst . foldr combine (Nothing, True)
where combine each (into, isFirst) = if isFirst
then (Just each, False)
else (Just each <> Just sep <> into, False)
View Parametricity.txt
Higgledy piggledy
quite a nice property
systems can have.
Enforcing the absence of
state or identity
up to the type level
is quite a salve.
View Main.hs
{-# LANGUAGE DeriveFoldable, DeriveFunctor, FlexibleContexts, KindSignatures, RankNTypes, TypeFamilies #-}
module Main where
import Data.Bifunctor
newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }
wrap :: Functor f => f (F f a) -> F f a
wrap f = F (\ p i -> i (fmap (\ (F r) -> r p i) f))
View FieldSet.hs
{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, PolyKinds, TypeOperators #-}
module FieldSet where
infix 9 :=>
-- | We can probably replace this with a wrapper around `Tagged`.
newtype a :=> b = (:=>) b
deriving (Eq, Show)
-- | “Smart” (actually quite dumb) constructor for the tagged type above for convenience
field :: b -> a :=> b
View 1. RFunctor.hs
-- Old friends.
newtype Fix f = Fix { unFix :: f (Fix f) }
data Free f a = Free (f (Free f a)) | Pure a
data Cofree f a = a :< f (Cofree f a)
-- A recursive functor. We can’t define a Functor instance for e.g. `Fix` because:
-- 1. Its type parameter is of kind (* -> *). Maybe PolyKinds could hack around this, I’ve not tried.
-- 2. Following from that, its type parameter is applied to `Fix f` itself, and thus `(f (Fix f) -> g (Fix g)) -> Fix f -> Fix g` would probably be a mistake too; we want to ensure that `Fix` recursively maps its parameter functor into the new type, and not leave that map the responsibility of the function argument.
class RFunctor f
where rmap :: Functor a => (a (f b) -> b (f b)) -> f a -> f b