Hacker Newsnew | past | comments | ask | show | jobs | submitlogin

This is about as close as I could get in Haskell so far. It uses a slight twist on (x -> a -> x) called a Fold (which has a lot of great properties—it's a profunctor, an applicative, and a comonad).

Nicely, this construction lets us write `take` purely!

    {-# LANGUAGE GADTs         #-}
    {-# LANGUAGE RankNTypes    #-}
    {-# LANGUAGE TypeOperators #-}

    import           Control.Arrow
    import           Control.Category
    import qualified Prelude
    import           Prelude hiding (id, (.))

    data Fold a r where
      Fold :: (a -> x -> x) -> x -> (x -> r) -> Fold a r

    data Pair a b = Pair !a !b

    pfst :: Pair a b -> a
    pfst (Pair a b) = a

    psnd :: Pair a b -> b
    psnd (Pair a b) = b

    newtype (~>) a b = Arr (forall r . Fold b r -> Fold a r)

    instance Category (~>) where
      id = Arr id
      Arr f . Arr g = Arr (g . f)

    amap :: (a -> b) -> (a ~> b)
    amap f = Arr (\(Fold cons nil fin) -> Fold (cons . f) nil fin)

    afilter :: (a -> Bool) -> (a ~> a)
    afilter p = Arr $ \(Fold cons nil fin) ->
      let cons' = \a x -> if p a then cons a x else x
      in Fold cons' nil fin

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

    asequence :: (a ~> b) -> ([a] -> [b])
    asequence (Arr f) = fold (f (Fold (:) [] id))
    
    aflatmap :: (a -> [b]) -> (a ~> b)
    aflatmap f = Arr $ \(Fold cons nil fin) ->
      Fold (\a x -> foldr cons x (f a)) nil fin
    
    atake :: Int -> (a ~> a)
    atake n = Arr $ \(Fold cons nil fin) ->
      let cons' = \a x n -> if n > 0 then cons a (x (n-1)) else x n
      in Fold cons' (const nil) (\x -> fin (x n))


Brilliant, this clears up the usage a lot more than the rest of the prose in the comment thread.




Guidelines | FAQ | Lists | API | Security | Legal | Apply to YC | Contact

Search: