Skip to content

Instantly share code, notes, and snippets.

@lotz84
Last active August 28, 2015 10:59
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save lotz84/0cbe22416319b6caf2e1 to your computer and use it in GitHub Desktop.
Save lotz84/0cbe22416319b6caf2e1 to your computer and use it in GitHub Desktop.
{-# LANGUAGE Rank2Types #-}
type List a = forall r. r -> (a -> r -> r) -> r

nil :: List a
nil x _ = x

cons :: a -> List a -> List a
cons x xs = \nil' cons' -> cons' x (xs nil' cons')

foldr :: (a -> b -> b) -> b -> List a -> b
foldr f z xs = xs z f

代数的データ型を使わないリスト

type Reducer a r = r -> a -> r
type Transducer a b = forall r . Reducer a r -> Reducer b r

mapping :: (a -> b) -> Transducer b a
mapping f xf r a = xf r (f a)

filtering :: (a -> Bool) -> Transducer a a
filtering p xf r a = if p a then xf r a else r

class Foldable f where
  fold :: Transducer a (f a)

class Conjable f where
  empty :: f a
  conj :: Reducer a (f a)
  
instance Foldable [] where
  fold = foldl

instance Conjable [] where
  empty = []
  conj xs x = xs ++ [x]

flatmapping :: Foldable f => (a -> f b) -> Transducer b a
flatmapping f xf r a = fold xf r (f a)

xlist :: (Foldable f, Conjable f) => Transducer b a -> f a -> f b
xlist xf = fold (xf conj) empty

xmap :: (Foldable f, Conjable f) => (a -> b) -> f a -> f b
xmap f = xlist $ mapping f

xfilter :: (Foldable f, Conjable f) => (a -> Bool) -> f a -> f a
xfilter p = xlist $ filtering p

xflatmap :: (Foldable f, Conjable f) => (a -> f b) -> f a -> f b
xflatmap f = xlist $ flatmapping f

Understanding Clojure transducers through types

step :: x -> a -> x
k   :: (x -> a -> x) -> (x -> b -> x)
k'  :: (a -> x -> x) -> (b -> x -> x)
k'' :: (a -> Endo x) -> (b -> Endo x)
k'' :: (a -> Constant (Endo x) a) -> (b -> Constant (Endo x) b)

Reducer transformers can definitely be encoded in a lens-like shape

newtype Fold a = Fold (forall r . (a -> r -> r) -> r -> r)

fold :: [a] -> Fold a
fold xs = Fold (spin xs) where
  spin []     cons nil = nil
  spin (a:as) cons nil = cons a (spin as cons nil)

refold :: Fold a -> [a]
refold (Fold f) = f (:) []

map :: (a -> b) -> (Fold a -> Fold b)
map x (Fold f) = Fold $ \cons nil -> f (cons . x) nil

filter :: (a -> Bool) -> Fold a -> Fold a
filter p (Fold f) =
  Fold $ \cons nil -> f (\a r -> if p a then cons a r else r) nil

foldSet :: Fold a -> Set a
foldSet (Fold f) = f Set.insert Set.empty

Hacker News - Transducers are coming to Clojure

{-
 - Transducer が
 - * 何であるか
 - * 何ができるのか
 -}

{-# LANGUAGE RankNTypes #-}

import Data.Functor.Contravariant

newtype Reducer r a = Reducer (a -> r -> r)

instance Contravariant (Reducer r) where
    contramap f (Reducer r) = Reducer $ r . f

-- type List a = forall r. (a -> r -> r) -> r -> r
type List a = forall r. Reducer r (Reducer r a)

nil :: List a
nil = Reducer $ \_ x -> x

cons :: a -> List a -> List a
cons x (Reducer xs) = Reducer $ \(Reducer cons') nil' -> cons' x (xs (Reducer cons') nil')

showL :: Show a => List a -> String
showL (Reducer r) = "[" ++ tail (r (Reducer (\x xs -> "," ++ show x ++ xs)) "]")

type Transducer a b = forall r. Reducer r a -> Reducer r b

-- natural transformation ?

transduce :: Transducer a b -> List b -> List a
transduce trans (Reducer r) = Reducer $ r . trans

mapping :: (a -> b) -> Transducer b a
mapping f xf = Reducer $ \a r -> xf (f a) r

filtering :: (a -> Bool) -> Transducer a a
filtering p xf = Reducer $ \a r -> if p a then xf a r else r

-- flatmapping :: Foldable f => (a -> f b) -> Transducer b a
-- flatmapping f xf r a = fold xf r (f a)

main = do
    putStrLn $ showL (cons 1 (cons 2 nil))
    putStrLn $ showL $ transduce (mapping (+1)) (cons 1 (cons 2 nil))
    putStrLn $ showL $ transduce (filtering odd) (cons 1 (cons 2 nil))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment