Skip to content

Instantly share code, notes, and snippets.

Avatar
🌊
every dot and stroke I paint will be alive

Rob Rix robrix

🌊
every dot and stroke I paint will be alive
View GitHub Profile
@robrix
robrix / Optics.hs
Created Oct 9, 2020
Optics via fused-effects
View Optics.hs
{-# LANGUAGE RankNTypes #-}
module Optics where
import Control.Category ((>>>))
import qualified Control.Category as Cat
import Control.Effect.Empty
import Control.Effect.NonDet hiding (empty)
import Control.Monad ((<=<))
-- riffing off of @serras’s post https://gist.github.com/serras/5152ec18ec5223b676cc67cac0e99b70
@robrix
robrix / Selective2.hs
Created Oct 3, 2020
What do we gain and what do we break by distributing f over -> in Selective?
View Selective2.hs
class Applicative f => Selective f where
branch :: f (Either a b) -> f (a -> c) -> f (b -> c) -> f c
branch ab f g = fmap (fmap Left) ab `select` fmap (fmap Right) f `select` g
select :: f (Either a b) -> f (a -> b) -> f b
select ab f = branch ab f (pure id)
{-# MINIMAL branch | select #-} -- Defining in terms of both to double-check my work
filteredBy :: (Alternative f, Selective f) => f a -> (a -> Bool) -> f a -- from Staged Selective Parser Combinators
@robrix
robrix / Deriving.hs
Last active Sep 28, 2020
Deriving of Functor instances via Applicative, and Functor & Applicative instances via Monad, using DerivingVia
View Deriving.hs
module Deriving
( ApplicativeInstance(..)
, MonadInstance(..)
) where
import Control.Applicative (liftA, liftA2)
import Control.Monad (ap, liftM, liftM2)
-- | 'Functor' instances derivable via an 'Applicative' instance, for use with @-XDerivingVia@.
--
@robrix
robrix / Mendler.hs
Created Sep 3, 2020
Mendler-style iteration in Haskell
View Mendler.hs
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
module Mendler where
class Iter b t | t -> b where
iter :: (forall x . (x -> a) -> b x -> a) -> t -> a
data ListF a b = Nil | Cons a b
instance Iter (ListF a) [a] where
@robrix
robrix / FoldableN.hs
Created Jun 20, 2020
Single-pass folding of multiple structures.
View FoldableN.hs
module Data.FoldableN where
import Control.Applicative -- for ZipList
import Linear.V1 -- for V1, an identity functor
import Linear.V2 -- for V2, data V2 a = V2 a a
class Foldable t => FoldableN t where
-- | Fold multiple structures into a 'Monoid'.
--
-- @
@robrix
robrix / NNat.hs
Last active Jan 25, 2020
N is for Natural; zero, or more
View NNat.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
module NNat where
@robrix
robrix / diffused-effects.txt
Created Sep 22, 2019
Results of compiling a benchmark against fused-effects & diffused-effects with -dshow-passes
View diffused-effects.txt
compile: input file benchmark/Send/Send10.hs
*** Checking old interface for Send.Send10 (use -ddump-hi-diffs for more details):
*** Parser [Send.Send10]:
!!! Parser [Send.Send10]: finished in 0.55 milliseconds, allocated 0.957 megabytes
*** Renamer/typechecker [Send.Send10]:
!!! Renamer/typechecker [Send.Send10]: finished in 186.13 milliseconds, allocated 77.516 megabytes
*** Desugar [Send.Send10]:
Result size of Desugar (before optimization)
= {terms: 195, types: 4,554, coercions: 6,170, joins: 0/7}
Result size of Desugar (after optimization)
@robrix
robrix / Rollable.hs
Last active Mar 11, 2018
Deriving a nonrecursive base functor from a recursive datatype using GHC.Generics
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
@robrix
robrix / ParameterizedRecursion.hs
Created Jun 29, 2017
Functions defined with fix are more composable than directly recursive functions
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…
@robrix
robrix / SES.hs
Last active Mar 2, 2017
SES (shortest edit script) implemented as a dynamorphism
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)
You can’t perform that action at this time.