module Data.Church.List
( module Data.Church.List
, module F
)
where
import Control.Applicative
import Control.Arrow hiding (loop)
import Control.Monad
import Data.Bool
import Data.Eq
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
import Data.Function
import Data.Int
import qualified Data.List as L
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.String hiding (unlines, unwords)
import Data.Traversable
import Data.Tuple
import Prelude (Num, Integral, (), error)
import Text.Show
newtype List a = List (forall r. Monoid r => (a -> r) -> r)
instance Show a => Show (List a) where
show (List c) = show (c (:[]))
instance Functor List where
fmap f (List c) = List (\k -> c (k . f))
instance Foldable List where
foldMap f (List c) = c f
instance Traversable List where
traverse f (List c) =
appEndo (c (\a -> Endo (liftA2 (<>) (pure <$> f a))))
(pure mempty)
instance Applicative List where
pure x = List (\k -> k x)
List f <*> List x = List (\k -> f (\g -> x (k .g)))
instance Monad List where
return = pure
List m >>= f = m f
instance Monoid (List a) where
mempty = List $ const mempty
List x `mappend` List y = List $ \k -> x k `mappend` y k
instance Alternative List where
empty = mempty
(<|>) = mappend
instance MonadPlus List where
mzero = mempty
mplus = mappend
uncons :: List a -> Maybe (a, List a)
uncons c = (, tail c) <$> headMay c
caseList :: b -> (a -> List a -> b) -> List a -> b
caseList b f xs = maybe b (uncurry f) (uncons xs)
cons :: a -> List a -> List a
cons x = (pure x <>)
snoc :: List a -> a -> List a
snoc c x = c <> pure x
fromList :: [a] -> List a
fromList xs = List $ \k -> F.foldMap k xs
head :: List a -> a
head = fromMaybe (error "Data.List.List.head: empty list") . headMay
headMay :: List a -> Maybe a
headMay (List c) = getFirst $ c (First . Just)
init :: List a -> List a
init = fromList . L.init . F.toList
initMay :: List a -> Maybe (List a)
initMay c = init c <$ headMay c
tail :: List a -> List a
tail = fromList . L.tail . F.toList
tailMay :: List a -> Maybe (List a)
tailMay c = tail c <$ headMay c
last :: List a -> a
last = fromMaybe (error "Data.List.List.last: empty list") . lastMay
lastMay :: List a -> Maybe a
lastMay (List c) = getLast $ c (Last . Just)
null :: List a -> Bool
null = isNothing . headMay
length :: List a -> Int
length (List c) = getSum $ c (const (Sum 1))
map :: (a -> b) -> List a -> List b
map = fmap
reverse :: List a -> List a
reverse = fromList . L.reverse . F.toList
intersperse :: a -> List a -> List a
intersperse a = fromList . L.intersperse a . F.toList
intercalate :: List a -> List (List a) -> List a
intercalate xs xss = concat (intersperse xs xss)
transpose :: List (List a) -> List (List a)
transpose =
fromList . L.map fromList . L.transpose . L.map F.toList . F.toList
subsequences :: List a -> List (List a)
subsequences = fromList . L.map fromList . L.subsequences . F.toList
permutations :: List a -> List (List a)
permutations = fromList . L.map fromList . L.permutations . F.toList
concat :: List (List a) -> List a
concat = (>>= id)
concatMap :: (a -> List b) -> List a -> List b
concatMap = flip (>>=)
scanl :: (a -> b -> a) -> a -> List b -> List a
scanl f q = fromList . L.scanl f q . F.toList
scanl1 :: (a -> a -> a) -> List a -> List a
scanl1 f = caseList mempty (scanl f)
scanr :: (a -> b -> b) -> b -> List a -> List b
scanr f q = fromList . L.scanr f q . F.toList
scanr1 :: (a -> a -> a) -> List a -> List a
scanr1 f = caseList mempty (scanr f)
mapAccumL :: (acc -> x -> (acc, y)) -> acc -> List x -> (acc, List y)
mapAccumL f q = fmap fromList . L.mapAccumL f q . F.toList
mapAccumR :: (acc -> x -> (acc, y)) -> acc -> List x -> (acc, List y)
mapAccumR f q = fmap fromList . L.mapAccumR f q . F.toList
iterate :: (a -> a) -> a -> List a
iterate f a = List $ \k -> fix (\loop b -> k b <> loop (f b)) a
repeat :: a -> List a
repeat a = List $ fix . (<>) . ($ a)
replicate :: Int -> a -> List a
replicate n a
| n <= 0 = mempty
| otherwise = List $ \k ->
fix (\loop i -> if i == 0
then mempty
else k a <> loop (i1)) n
cycle :: List a -> List a
cycle xs = xs <> cycle xs
unfoldr :: (b -> Maybe (a, b)) -> b -> List a
unfoldr f b = List $ \k ->
fix (\loop c -> case f c of
Nothing -> mempty
Just (a, b') -> k a <> loop b') b
splitAt :: Int -> List a -> (List a, List a)
splitAt n = (fromList *** fromList) . L.splitAt n . F.toList
takeWhile :: (a -> Bool) -> List a -> List a
takeWhile f = fromList . L.takeWhile f . F.toList
dropWhile :: (a -> Bool) -> List a -> List a
dropWhile f = fromList . L.dropWhile f . F.toList
dropWhileEnd :: (a -> Bool) -> List a -> List a
dropWhileEnd p = fromList . L.dropWhileEnd p . F.toList
span :: (a -> Bool) -> List a -> (List a, List a)
span f = (fromList *** fromList) . L.span f . F.toList
break :: (a -> Bool) -> List a -> (List a, List a)
break f = (fromList *** fromList) . L.break f . F.toList
stripPrefix :: Eq a => List a -> List a -> Maybe (List a)
stripPrefix x y = fromList <$> L.stripPrefix (F.toList x) (F.toList y)
group :: Eq a => List a -> List (List a)
group = fromList . fmap fromList . L.group . F.toList
inits :: List a -> List (List a)
inits = fromList . fmap fromList . L.inits . F.toList
tails :: List a -> List (List a)
tails = fromList . fmap fromList . L.tails . F.toList
isPrefixOf :: Eq a => List a -> List a -> Bool
isPrefixOf x y = F.toList x `L.isPrefixOf` F.toList y
isSuffixOf :: Eq a => List a -> List a -> Bool
isSuffixOf x y = F.toList x `L.isSuffixOf` F.toList y
isInfixOf :: Eq a => List a -> List a -> Bool
isInfixOf x y = F.toList x `L.isInfixOf` F.toList y
lookup :: Eq a => a -> List (a, b) -> Maybe b
lookup a (List c) = getFirst $ c $ \(x, b) ->
First (mfilter (const (a == x)) (Just b))
filter :: (a -> Bool) -> List a -> List a
filter f (List c) = c $ \a -> mfilter f (pure a)
partition :: (a -> Bool) -> List a -> (List a, List a)
partition f (List c) = c $ \a ->
if f a then (pure a, mempty) else (mempty, pure a)
(!!) :: List a -> Int -> a
xs !! n = F.toList xs L.!! n
elemIndex :: Eq a => a -> List a -> Maybe Int
elemIndex x = findIndex (x ==)
elemIndices :: Eq a => a -> List a -> List Int
elemIndices x = findIndices (x ==)
findIndex :: (a -> Bool) -> List a -> Maybe Int
findIndex p = listToMaybe . F.toList . findIndices p
findIndices :: (a -> Bool) -> List a -> List Int
findIndices f = fromList . L.findIndices f . F.toList
zip :: List a -> List b -> List (a, b)
zip = zipWith (,)
zip3 :: List a -> List b -> List c -> List (a, b, c)
zip3 = zipWith3 (,,)
zip4 :: List a -> List b -> List c -> List d -> List (a, b, c, d)
zip4 = zipWith4 (,,,)
zip5 :: List a -> List b -> List c -> List d -> List e
-> List (a, b, c, d, e)
zip5 = zipWith5 (,,,,)
zip6 :: List a -> List b -> List c -> List d -> List e -> List f
-> List (a, b, c, d, e, f)
zip6 = zipWith6 (,,,,,)
zip7 :: List a
-> List b
-> List c
-> List d
-> List e
-> List f
-> List g
-> List (a, b, c, d, e, f, g)
zip7 = zipWith7 (,,,,,,)
zipWith :: (a -> b -> c) -> List a -> List b -> List c
zipWith z
(uncons -> Just (a, as))
(uncons -> Just (b, bs))
= z a b `cons` zipWith z as bs
zipWith _ _ _ = mempty
zipWith3 :: (a -> b -> c -> d) -> List a -> List b -> List c -> List d
zipWith3 z
(uncons -> Just (a, as))
(uncons -> Just (b, bs))
(uncons -> Just (c, cs))
= z a b c `cons` zipWith3 z as bs cs
zipWith3 _ _ _ _ = mempty
zipWith4 :: (a -> b -> c -> d -> e)
-> List a
-> List b
-> List c
-> List d
-> List e
zipWith4 z
(uncons -> Just (a, as))
(uncons -> Just (b, bs))
(uncons -> Just (c, cs))
(uncons -> Just (d, ds))
= z a b c d `cons` zipWith4 z as bs cs ds
zipWith4 _ _ _ _ _ = mempty
zipWith5 :: (a -> b -> c -> d -> e -> f)
-> List a
-> List b
-> List c
-> List d
-> List e
-> List f
zipWith5 z
(uncons -> Just (a, as))
(uncons -> Just (b, bs))
(uncons -> Just (c, cs))
(uncons -> Just (d, ds))
(uncons -> Just (e, es))
= z a b c d e `cons` zipWith5 z as bs cs ds es
zipWith5 _ _ _ _ _ _ = mempty
zipWith6 :: (a -> b -> c -> d -> e -> f -> g)
-> List a
-> List b
-> List c
-> List d
-> List e
-> List f
-> List g
zipWith6 z
(uncons -> Just (a, as))
(uncons -> Just (b, bs))
(uncons -> Just (c, cs))
(uncons -> Just (d, ds))
(uncons -> Just (e, es))
(uncons -> Just (f, fs))
= z a b c d e f `cons` zipWith6 z as bs cs ds es fs
zipWith6 _ _ _ _ _ _ _ = mempty
zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h)
-> List a
-> List b
-> List c
-> List d
-> List e
-> List f
-> List g
-> List h
zipWith7 z
(uncons -> Just (a, as))
(uncons -> Just (b, bs))
(uncons -> Just (c, cs))
(uncons -> Just (d, ds))
(uncons -> Just (e, es))
(uncons -> Just (f, fs))
(uncons -> Just (g, gs))
= z a b c d e f g `cons` zipWith7 z as bs cs ds es fs gs
zipWith7 _ _ _ _ _ _ _ _ = mempty
unzip :: List (a, b) -> (List a, List b)
unzip = F.foldr
(\(a,b) ~(as,bs) ->
(a `cons` as,
b `cons` bs))
(mempty,mempty)
unzip3 :: List (a, b, c) -> (List a, List b, List c)
unzip3 = F.foldr
(\(a,b,c) ~(as,bs,cs) ->
(a `cons` as,
b `cons` bs,
c `cons` cs))
(mempty,mempty,mempty)
unzip4 :: List (a, b, c, d) -> (List a, List b, List c, List d)
unzip4 = F.foldr
(\(a,b,c,d) ~(as,bs,cs,ds) ->
(a `cons` as,
b `cons` bs,
c `cons` cs,
d `cons` ds))
(mempty,mempty,mempty,mempty)
unzip5 :: List (a, b, c, d, e)
-> (List a, List b, List c, List d, List e)
unzip5 = F.foldr
(\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
(a `cons` as,
b `cons` bs,
c `cons` cs,
d `cons` ds,
e `cons` es))
(mempty,mempty,mempty,mempty,mempty)
unzip6 :: List (a, b, c, d, e, f)
-> (List a, List b, List c, List d, List e, List f)
unzip6 = F.foldr
(\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
(a `cons` as,
b `cons` bs,
c `cons` cs,
d `cons` ds,
e `cons` es,
f `cons` fs))
(mempty,mempty,mempty,mempty,mempty,mempty)
unzip7 :: List (a, b, c, d, e, f, g)
-> (List a, List b, List c, List d, List e, List f, List g)
unzip7 = F.foldr
(\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
(a `cons` as,
b `cons` bs,
c `cons` cs,
d `cons` ds,
e `cons` es,
f `cons` fs,
g `cons` gs))
(mempty,mempty,mempty,mempty,mempty,mempty,mempty)
lines :: String -> List String
lines = fromList . L.lines
words :: String -> List String
words = fromList . L.words
unlines :: List String -> String
unlines = L.unlines . F.toList
unwords :: List String -> String
unwords = L.unwords . F.toList
nub :: Eq a => List a -> List a
nub = fromList . L.nub . F.toList
delete :: Eq a => a -> List a -> List a
delete = deleteBy (==)
(\\) :: Eq a => List a -> List a -> List a
(\\) = F.foldl (flip delete)
union :: Eq a => List a -> List a -> List a
union = unionBy (==)
intersect :: Eq a => List a -> List a -> List a
intersect = intersectBy (==)
sort :: Ord a => List a -> List a
sort = sortBy compare
insert :: Ord a => a -> List a -> List a
insert = insertBy compare
nubBy :: (a -> a -> Bool) -> List a -> List a
nubBy f = fromList . L.nubBy f . F.toList
deleteBy :: (a -> a -> Bool) -> a -> List a -> List a
deleteBy f a = fromList . L.deleteBy f a . F.toList
deleteFirstsBy :: (a -> a -> Bool) -> List a -> List a -> List a
deleteFirstsBy eq = F.foldl (flip (deleteBy eq))
unionBy :: (a -> a -> Bool) -> List a -> List a -> List a
unionBy f x y = fromList $ L.unionBy f (F.toList x) (F.toList y)
intersectBy :: (a -> a -> Bool) -> List a -> List a -> List a
intersectBy f x y = fromList $ L.intersectBy f (F.toList x) (F.toList y)
groupBy :: (a -> a -> Bool) -> List a -> List (List a)
groupBy f = fromList . fmap fromList . L.groupBy f . F.toList
sortBy :: (a -> a -> Ordering) -> List a -> List a
sortBy f = fromList . L.sortBy f . F.toList
insertBy :: (a -> a -> Ordering) -> a -> List a -> List a
insertBy cmp a = fromList . L.insertBy cmp a . F.toList
genericLength :: Num i => List b -> i
genericLength = L.genericLength . F.toList
genericTake :: Integral i => i -> List a -> List a
genericTake n = fromList . L.genericTake n . F.toList
genericDrop :: Integral i => i -> List a -> List a
genericDrop n = fromList . L.genericDrop n . F.toList
genericSplitAt :: Integral i => i -> List b -> (List b, List b)
genericSplitAt n = (fromList *** fromList) . L.genericSplitAt n . F.toList
genericIndex :: Integral a => List b -> a -> b
genericIndex xs = L.genericIndex (F.toList xs)
genericReplicate :: Integral i => i -> a -> List a
genericReplicate n a
| n <= 0 = mempty
| otherwise = List $ \k ->
fix (\loop i -> if i == 0
then mempty
else k a <> loop (i1)) n