{-# LANGUAGE BangPatterns #-}
module Network.Wai.Handler.Warp.Some (
Some
, singleton
, top
, lookupWith
, union
, toList
, prune
) where
----------------------------------------------------------------
-- | One ore more list to implement multimap.
data Some a = One !a
| Tom !a !(Some a) -- Two or more
deriving (Eq,Show)
{-# INLINE singleton #-}
singleton :: a -> Some a
singleton x = One x
{-# INLINE top #-}
top :: Some a -> a
top (One x) = x
top (Tom x _) = x
{-# INLINE lookupWith #-}
lookupWith :: (a -> Bool) -> Some a -> Maybe a
lookupWith f s = go s
where
go (One x)
| f x = Just x
| otherwise = Nothing
go (Tom x xs)
| f x = Just x
| otherwise = go xs
{-# INLINE union #-}
union :: Some a -> Some a -> Some a
union s t = go s t
where
go (One x) u = Tom x u
go (Tom x xs) u = go xs (Tom x u)
{-# INLINE toList #-}
toList :: Some a -> [a]
toList s = go s []
where
go (One x) !acc = x : acc
go (Tom x xs) !acc = go xs (x : acc)
{-# INLINE prune #-}
prune :: (a -> IO Bool) -> Some a -> IO (Maybe (Some a))
prune act s = go s
where
go (One x) = do
keep <- act x
return $ if keep then
Just (One x)
else
Nothing
go (Tom x xs) = do
keep <- act x
mys <- go xs
return $ if keep then
case mys of
Nothing -> Just (One x)
Just ys -> Just (Tom x ys)
else
mys