Last active
November 16, 2015 07:03
-
-
Save gseitz/8980e3c51edcb0f19f83 to your computer and use it in GitHub Desktop.
CanBuildFrom.hs
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-#LANGUAGE FlexibleInstances #-} | |
module CanBuildFrom where | |
import Data.Foldable | |
import Data.Map | |
data Builder from elem to = Builder { | |
result :: to, | |
add :: elem -> Builder from elem to | |
} | |
mkBuilder :: to -> (elem -> to -> to) -> Builder from elem to | |
mkBuilder res add' = Builder res $ \el -> mkBuilder (add' el res) add' | |
class CanBuildFrom from elem to where | |
-- passing 'from' as a parameter helps with type inference | |
builder :: from -> Builder from elem to | |
instance Ord a => CanBuildFrom from (a,b) (Map a b) where | |
builder _ = mkBuilder Data.Map.empty (\(k,v) m -> Data.Map.insert k v m) | |
instance CanBuildFrom [a] b [b] where | |
builder _ = mkBuilder [] (:) | |
mapCBF :: (CanBuildFrom (from a) elem to, Foldable from) => from a -> (a -> elem) -> to | |
mapCBF from f = result $ Data.Foldable.foldl append (builder from) from | |
where | |
append b e = add b (f e) | |
-- [(a,b)] -> Map a b | |
-- λ> mapCBF ["foo_bar", "baz_quux"] (span ('_' /=)) :: Map String String | |
-- fromList [("baz","_quux"),("foo","_bar")] | |
-- [(a,b)] -> [(a,b)] | |
-- λ> mapCBF ["foo_bar", "baz_quux"] (span ('_' /=)) :: [(String, String)] | |
-- [("baz","_quux"),("foo","_bar")] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment