module Data.Extensible.Internal.Rig where
import Unsafe.Coerce
import Control.Applicative
import Data.Typeable
import Data.Monoid
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s
view :: ((a -> Const a a) -> (s -> Const a s)) -> s -> a
view l = views l id
views :: ((a -> Const r a) -> (s -> Const r s)) -> (a -> r) -> s -> r
views = unsafeCoerce
newtype K0 a = K0 { getK0 :: a } deriving (Eq, Ord, Read, Typeable, Functor, Foldable, Traversable)
instance Applicative K0 where
pure = K0
K0 f <*> K0 a = K0 (f a)
instance Monad K0 where
return = K0
K0 a >>= k = k a
instance Show a => Show (K0 a) where
showsPrec d (K0 a) = showParen (d > 10) $ showString "K0 " . showsPrec 11 a
over :: ((a -> K0 a) -> s -> K0 s) -> (a -> a) -> s -> s
over = unsafeCoerce
newtype Const' a x = Const' { getConst' :: a } deriving Show
newtype Match h a x = Match { runMatch :: h x -> a } deriving Typeable
data Nullable h x = Null | Eine (h x) deriving (Show, Eq, Ord, Typeable)
nullable :: r -> (h x -> r) -> Nullable h x -> r
nullable r _ Null = r
nullable _ f (Eine h) = f h
mapNullable :: (g x -> h y) -> Nullable g x -> Nullable h y
mapNullable f (Eine g) = Eine (f g)
mapNullable _ Null = Null
newtype MergeList a = MergeList { getMerged :: [a] } deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
instance Monoid (MergeList a) where
mempty = MergeList []
mappend (MergeList a) (MergeList b) = MergeList $ merge a b where
merge (x:xs) (y:ys) = x : y : merge xs ys
merge xs [] = xs
merge [] ys = ys