module Cgm.Data.List (
testList,
List(..),
listHead,
addListContext,
foldWithContext,
prependReverse,
listFoldMap,
Sizable(..),
listStructure,
maybeMaximumBy,
maxBy,
unfoldlE,
unfoldrE
) where
import Data.Collections.Foldable as Foldable
import Data.Monoid
import Cgm.Control.Combinators
import Cgm.Control.InFunctor
import Control.Arrow
testList :: b -> (a -> [a] -> b) -> [a] -> b
testList empty nonEmpty list = case list of {[] -> empty; (x:xs) -> nonEmpty x xs}
class List a where
type Listed a :: *
onList :: b -> (Listed a -> a -> b) -> a -> b
consList :: Listed a -> a -> a
emptyList :: a
prependReverse :: List a => a -> a -> a
prependReverse rev end = onList end (\r rs -> prependReverse rs $ consList r end) rev
instance List [a] where
type Listed [a] = a
onList e _ [] = e
onList _ c (x:xs) = c x xs
consList = (:)
emptyList = []
listFoldMap :: (List a, Monoid m) => (Listed a -> m) -> a -> m
listFoldMap f = onList mempty $ dot2 mappend f $ listFoldMap f
listHead :: List a => a -> Maybe (Listed a)
listHead = onList Nothing (Just ./ const)
addListContext :: (List a, List c, Listed a ~ Listed c) => a -> [(c, Listed a, a)]
addListContext = foldWithContext (\before elem after -> ((before, elem, after) :)) []
foldWithContext :: (List a, List c, Listed a ~ Listed c) => (c -> Listed a -> a -> b -> b) -> b -> a -> b
foldWithContext f e = fold2 emptyList
where fold2 revPrefix = onList e (\x suffix -> f revPrefix x suffix (fold2 (consList x revPrefix) suffix))
class Sizable a where countDown :: Int -> a -> Maybe Int
listStructure :: List a => Bijection' a (Maybe (Listed a, a))
listStructure = uncheckedBijection (onList Nothing $ Just ./ (,)) (maybe emptyList $ uncurry consList)
maybeMaximumBy :: Foldable l a => (a -> a -> Ordering) -> l -> Maybe a
maybeMaximumBy o = Foldable.foldr (\a -> Just . maybe a (maxBy o a)) Nothing
maxBy :: (a -> a -> Ordering) -> a -> a -> a
maxBy o a b = case o a b of {GT -> a; _ -> b}
unfoldlE :: (b -> Either c (b, a)) -> b -> (c, [a])
unfoldlE f = unfoldl' []
where unfoldl' as = either (, as) (\(b', a) -> unfoldl' (a : as) b') . f
unfoldrE :: (b -> Either c (a, b)) -> b -> ([a], c)
unfoldrE f = either ([], ) (\(a, b') -> first (a:) $ unfoldrE f b') . f