either-list-functions 0.0.2.0 → 0.0.4.0

raw patch · 4 files changed

+284/−64 lines, 4 filesdep +containersdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• changelog.txt +12/−0
• either-list-functions.cabal +12/−9
• license.txt +1/−1
• src/Data/List/EitherFunctions.hs +259/−54

@@ -1,3 +1,15 @@+0.0.4.0+  - Added:+      - spanLeft'+      - spanRight'+      - leadLeft+      - leadLeft'+      - leadRight+      - leadRight'+      - branchLeft+      - branchRight+      - BranchComparison+ 0.0.2.0   - Supports base-4.12   - Added 'partition' function

@@ -1,5 +1,5 @@ name:     either-list-functions-version:  0.0.2.0+version:  0.0.4.0 category: Data synopsis: Functions involving lists of Either @@ -28,12 +28,14 @@   default-language: Haskell2010   hs-source-dirs: src   ghc-options: -Wall+  exposed-modules: Data.List.EitherFunctions+  build-depends: base, containers -  build-depends:-      base >=4.9 && <4.13+  -- require Data.Functor.Contravariant+  build-depends: base >=4.12 -  exposed-modules:-      Data.List.EitherFunctions+  -- upper bounds to exclude untested versions+  build-depends: base <4.13, containers <0.7  test-suite doctest   default-language: Haskell2010@@ -41,8 +43,9 @@   main-is: doctest.hs   ghc-options: -Wall -threaded   hs-source-dirs: test+  build-depends: base, doctest, either-list-functions -  build-depends:-      base >=4.9 && <4.13-    , doctest-    , either-list-functions+  build-depends: base >=4.12++  -- upper bounds to exclude untested versions+  build-depends: base <4.13

@@ -1,4 +1,4 @@-Copyright 2017 Chris Martin+Copyright 2017-2020 Chris Martin  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.

@@ -1,80 +1,285 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE BlockArguments, LambdaCase, NoImplicitPrelude #-} -module Data.List.EitherFunctions-  ( partlyMap-  , groupEither-  , spanLeft-  , spanRight-  , partition-  ) where+-- | Functions involving lists of 'Either'. -import Data.Either (Either (..))-import Data.Maybe  (Maybe (..), maybe)+module Data.List.EitherFunctions+  ( -import qualified Data.List as List+    {- * Map       -}  partlyMap,+    {- * Group     -}  groupEither,+    {- * Partition -}  partition,+    {- * Span      -}  spanLeft, spanLeft', spanRight, spanRight',+    {- * Lead      -}  leadLeft, leadLeft', leadRight, leadRight',+    {- * Branch    -}  branchLeft, branchRight, BranchComparison -{- |+  ) where ->>> import Prelude (even, show)+import Data.Bool                   ( Bool (..) )+import Data.Either                 ( Either (..) )+import Data.Function               ( fix )+import Data.Functor.Contravariant  ( Comparison (..), contramap )+import Data.List                   ( foldr, map, span )+import Data.Tree                   ( Tree (..), Forest )+import Data.Maybe                  ( Maybe (..), maybe )+import Data.Ord                    ( Ordering (..) ) ->>> partlyMap (\x -> if even x then Just (show x) else Nothing) [1..5]-[Left 1,Right "2",Left 3,Right "4",Left 5]+-- |+-- >>> import Prelude (even, show)+--+-- >>> partlyMap (\x -> if even x then Just (show x) else Nothing) [1..5]+-- [Left 1,Right "2",Left 3,Right "4",Left 5] --} partlyMap :: (a -> Maybe b) -> [a] -> [Either a b]-partlyMap f = List.map (\x -> maybe (Left x) Right (f x)) -{- |+partlyMap f = map \x -> maybe (Left x) Right (f x) ->>> groupEither [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']-[Left [1,2],Right "a",Left [3],Right "bc"]+-- |+-- >>> groupEither [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- [Left [1,2],Right "a",Left [3],Right "bc"] --} groupEither :: [Either a b] -> [Either [a] [b]]-groupEither [] = []-groupEither ((Left x) : xs)  = let (ys, zs) = spanLeft xs-                               in  Left (x : ys) : groupEither zs-groupEither ((Right x) : xs) = let (ys, zs) = spanRight xs-                               in  Right (x : ys) : groupEither zs -{- |+groupEither = fix \r -> \case+    []            ->  []+    Left  x : xs  ->  Left  (x : ys) : r zs  where (ys, zs) = spanLeft  xs+    Right x : xs  ->  Right (x : ys) : r zs  where (ys, zs) = spanRight xs ->>> spanLeft [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']-([1,2],[Right 'a',Left 3,Right 'b',Right 'c'])+-- |+-- >>> leadLeft [Right 'a', Right 'b', Left 1, Right 'c', Right 'd', Left 2, Right 'e', Right 'f']+-- ("ab",[(1,"cd"),(2,"ef")])+--+-- >>> leadLeft [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- ("",[(1,""),(2,"a"),(3,"bc")]) ->>> spanLeft [Right 'a', Left 3, Right 'b', Right 'c']-([],[Right 'a',Left 3,Right 'b',Right 'c'])+leadLeft :: [Either a b] -> ([b], [(a, [b])]) --}+leadLeft = f+  where+    f xs = (unledItems, ledGroups)+      where+        (unledItems, ysMaybe) = spanRight' xs+        ledGroups = case ysMaybe of+            Nothing            ->  []+            Just (leader, ys)  ->  r leader ys++    r leader xs = firstGroup : moreGroups+      where+        firstGroup = (leader, followers)+        (followers, ysMaybe) = spanRight' xs+        moreGroups = case ysMaybe of+            Nothing             ->  []+            Just (leader', ys)  ->  r leader' ys++-- |+-- >>> leadLeft' 0 [Right 'a', Right 'b', Left 1, Right 'c', Right 'd', Left 2, Right 'e', Right 'f']+-- [(0,"ab"),(1,"cd"),(2,"ef")]+--+-- >>> leadLeft' 0 [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- [(1,""),(2,"a"),(3,"bc")]++leadLeft' ::+    a -- ^ Leader to use for the first group in case the list does not begin with a 'Left'.+    -> [Either a b] -> [(a, [b])]++leadLeft' leader xs = addMissingLeader leader (leadLeft xs)++-- |+-- >>> leadRight [Left 1, Left 2, Right 'a', Left 3, Left 4, Right 'b', Left 5, Left 6]+-- ([1,2],[('a',[3,4]),('b',[5,6])])+--+-- >>> leadRight [Right 'a', Left 3, Left 4, Right 'b', Right 'c', Left 5, Left 6]+-- ([],[('a',[3,4]),('b',[]),('c',[5,6])])++leadRight :: [Either a b] -> ([a], [(b, [a])])++leadRight = f+  where+    f xs = (unledItems, ledGroups)+      where+        (unledItems, ysMaybe) = spanLeft' xs+        ledGroups = case ysMaybe of+            Nothing            ->  []+            Just (leader, ys)  ->  r leader ys++    r leader xs = firstGroup : moreGroups+      where+        firstGroup = (leader, followers)+        (followers, ysMaybe) = spanLeft' xs+        moreGroups = case ysMaybe of+            Nothing             ->  []+            Just (leader', ys)  ->  r leader' ys++-- |+-- >>> leadRight' 'z' [Left 1, Left 2, Right 'a', Left 3, Left 4, Right 'b', Left 5, Left 6]+-- [('z',[1,2]),('a',[3,4]),('b',[5,6])]+--+-- >>> leadRight' 'z' [Right 'a', Left 3, Left 4, Right 'b', Right 'c', Left 5, Left 6]+-- [('a',[3,4]),('b',[]),('c',[5,6])]++leadRight' ::+    b -- ^ Leader to use for the first group in case the list does not begin with a 'Right'.+    -> [Either a b] -> [(b, [a])]++leadRight' leader xs = addMissingLeader leader (leadRight xs)++addMissingLeader :: a -> ([b], [(a, [b])]) -> [(a, [b])]++addMissingLeader _      ( []         , groups ) =                        groups+addMissingLeader leader ( unledIntro , groups ) = (leader, unledIntro) : groups++-- |+-- >>> spanLeft [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- ([1,2],[Right 'a',Left 3,Right 'b',Right 'c'])+--+-- >>> spanLeft [Right 'a', Left 3, Right 'b', Right 'c']+-- ([],[Right 'a',Left 3,Right 'b',Right 'c'])+ spanLeft :: [Either a b] -> ([a], [Either a b])-spanLeft [] = ([], [])-spanLeft ((Left x) : xs) = let (ys, zs) = spanLeft xs-                           in  (x : ys, zs)-spanLeft xs = ([], xs) -{- |+spanLeft = fix \r -> \case+    []           ->  ( []     , [] )+    Left x : xs  ->  ( x : ys , zs )  where (ys, zs) = r xs+    xs           ->  ( []     , xs ) ->>> spanRight [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']-("",[Left 1,Left 2,Right 'a',Left 3,Right 'b',Right 'c'])+-- | Similar to 'spanLeft', but preserves a little more information in the return type: if the remainder of the list is non-empty, then it necessarily begins with a 'Right', and so we can go ahead and unwrap that and return it as a value of type `b`.+--+-- >>> spanLeft' [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- ([1,2],Just ('a',[Left 3,Right 'b',Right 'c']))+--+-- >>> spanLeft' [Right 'a', Left 3, Right 'b', Right 'c']+-- ([],Just ('a',[Left 3,Right 'b',Right 'c']))+--+-- >>> spanLeft' [Left 1, Left 2, Left 3]+-- ([1,2,3],Nothing) ->>> spanRight [Right 'a', Left 3, Right 'b', Right 'c']-("a",[Left 3,Right 'b',Right 'c'])+spanLeft' :: [Either a b] -> ([a], Maybe (b, [Either a b])) --}+spanLeft' = fix \r -> \case+    []            ->  ( []     , Nothing      )+    Left  x : xs  ->  ( x : ys , zs           )  where (ys, zs) = r xs+    Right x : xs  ->  ( []     , Just (x, xs) )++-- | Similar to 'spanRight', but preserves a little more information in the return type: if the remainder of the list is non-empty, then it necessarily begins with a 'Left', and so we can go ahead and unwrap that and return it as a value of type `a`.+--+-- >>> spanRight [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- ("",[Left 1,Left 2,Right 'a',Left 3,Right 'b',Right 'c'])+--+-- >>> spanRight [Right 'a', Left 3, Right 'b', Right 'c']+-- ("a",[Left 3,Right 'b',Right 'c'])+ spanRight :: [Either a b] -> ([b], [Either a b])-spanRight [] = ([], [])-spanRight ((Right x) : xs) = let (ys, zs) = spanRight xs-                             in  (x : ys, zs)-spanRight xs = ([], xs) -{- |+spanRight = fix \r -> \case+    []            ->  ( []     , [] )+    Right x : xs  ->  ( x : ys , zs )  where (ys, zs) = r xs+    xs            ->  ( []     , xs ) ->>> partition [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']-([1,2,3],"abc")+-- |+-- >>> spanRight' [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- ("",Just (1,[Left 2,Right 'a',Left 3,Right 'b',Right 'c']))+--+-- >>> spanRight' [Right 'a', Left 3, Right 'b', Right 'c']+-- ("a",Just (3,[Right 'b',Right 'c']))+--+-- >>> spanRight' [Right 'a', Right 'b', Right 'c']+-- ("abc",Nothing) --}+spanRight' :: [Either a b] -> ([b], Maybe (a, [Either a b]))++spanRight' = fix \r -> \case+    []            ->  ( []     , Nothing      )+    Right x : xs  ->  ( x : ys , zs           )  where (ys, zs) = r xs+    Left  x : xs  ->  ( []     , Just (x, xs) )++-- |+-- >>> partition [Left 1, Left 2, Right 'a', Left 3, Right 'b', Right 'c']+-- ([1,2,3],"abc")+ partition :: [Either a b] -> ([a], [b])-partition [] = ([], [])-partition (x : xs) = let (as, bs) = partition xs-                     in  case x of Left a  -> (a : as, bs)-                                   Right b -> (as, b : bs)++partition = fix \r -> \case+    []            ->  ( []     , []     )+    Left  a : xs  ->  ( a : as , bs     )  where (as, bs) = r xs+    Right b : xs  ->  ( as     , b : bs )  where (as, bs) = r xs++-- | The relative significance of branches (greater values are closer to the root).+type BranchComparison a = Comparison a++-- |+-- >>> import Prelude+--+-- >>> heading level title = Left (level, title)+-- >>> chapter = heading 1+-- >>> section = heading 2+-- >>> p text = Right text+--+-- >>> :{+-- >>> list =+-- >>>     [ p "Copyright"+-- >>>     , p "Preface"+-- >>>     , chapter "Animals"+-- >>>     , p "The kingdom animalia"+-- >>>     , section "Vertibrates"+-- >>>     , p "Cats"+-- >>>     , p "Snakes"+-- >>>     , section "Invertibrates"+-- >>>     , p "Worms"+-- >>>     , p "Jellyfishes"+-- >>>     , chapter "Fungus"+-- >>>     , p "Yeast"+-- >>>     , p "Truffles"+-- >>>     , p "Morels"+-- >>>     ]+-- >>> :}+--+-- >>> import Data.Functor.Contravariant+-- >>> flipComparison (Comparison f) = Comparison (flip f)+-- >>> headingComparison = contramap fst (flipComparison defaultComparison)+--+-- >>> (frontMatter, mainMatter) = branchLeft headingComparison list+--+-- >>> frontMatter+-- ["Copyright","Preface"]+--+-- >>> import Data.List+-- >>> showContent ((_, x), ys) = x ++ ": " ++ intercalate ", " ys+--+-- >>> import Data.Tree+-- >>> putStrLn $ drawForest $ map (fmap showContent) mainMatter+-- Animals: The kingdom animalia+-- |+-- +- Vertibrates: Cats, Snakes+-- |+-- `- Invertibrates: Worms, Jellyfishes+-- <BLANKLINE>+-- Fungus: Yeast, Truffles, Morels+-- <BLANKLINE>+-- <BLANKLINE>++branchLeft :: BranchComparison a -> [Either a b] -> ([b], Forest (a, [b]))++branchLeft c xs = (rejects, forest)+  where+    (rejects, nodes) = leadLeft xs+    forest = makeForest c' nodes+    c' = contramap (\(x, _) -> x) c++-- | Same as 'branchLeft', but with the types flipped; here, 'Right' is the case that indicates a branch.++branchRight :: BranchComparison b -> [Either a b] -> ([a], Forest (b, [a]))++branchRight c xs = (rejects, forest)+  where+    (rejects, nodes) = leadRight xs+    forest = makeForest c' nodes+    c' = contramap (\(x, _) -> x) c++makeForest :: BranchComparison a -> [a] -> Forest a++makeForest c = foldr f []+  where+    f x xs = Node x chomped : remainder+      where+        (chomped, remainder) = span (\(Node y _) -> x > y) xs++    x > y = case getComparison c x y of GT -> True; _ -> False