module Generics.Regular.Functions.Crush (
Crush (..), Assoc(..),
flattenl, flattenr, crushr, crushl
) where
import Generics.Regular.Base
data Assoc = AssocLeft
| AssocRight
class Crush f where
crush :: Assoc -> (a -> b -> b) -> b -> f a -> b
instance Crush I where
crush _ op e (I x) = x `op` e
instance Crush (K a) where
crush _ _ e _ = e
instance Crush U where
crush _ _ e _ = e
instance (Crush f, Crush g) => Crush (f :+: g) where
crush asc op e (L x) = crush asc op e x
crush asc op e (R y) = crush asc op e y
instance (Crush f, Crush g) => Crush (f :*: g) where
crush asc@AssocRight op e (x :*: y) = crush asc op (crush asc op e y) x
crush asc@AssocLeft op e (x :*: y) = crush asc op (crush asc op e x) y
instance Crush f => Crush (C c f) where
crush asc op e (C x) = crush asc op e x
instance Crush f => Crush (S s f) where
crush asc op e (S x) = crush asc op e x
flattenr, flattenl :: Crush f => f a -> [a]
flattenr = crushr (:) []
flattenl = crushl (:) []
crushr, crushl :: Crush f => (a -> b -> b) -> b -> f a -> b
crushr = crush AssocRight
crushl = crush AssocLeft