either-list-functions 0.0.0.2 → 0.0.4.8
raw patch · 4 files changed
Files
- changelog.md +37/−0
- either-list-functions.cabal +39/−42
- license.txt +1/−1
- src/Data/List/EitherFunctions.hs +263/−45
+ changelog.md view
@@ -0,0 +1,37 @@+### 0.0.4.8++Version bumps++### 0.0.4.7++Supports base-4.17 and GHC 9.4++### 0.0.4.6++Supports base-4.16 and GHC 9.2++### 0.0.4.5++Supports base-4.15 and GHC 9.0++### 0.0.4.4++Supports base-4.14 and GHC 8.8++### 0.0.4.2++Supports base-4.13 and GHC 8.8++### 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
either-list-functions.cabal view
@@ -1,49 +1,46 @@--- This file has been generated from package.yaml by hpack version 0.20.0.------ see: https://github.com/sol/hpack------ hash: 0a8c69b63be2cc464d5845e725a023129f39c228c94d1448f9bceb154ca78870+cabal-version: 3.0 -name: either-list-functions-version: 0.0.0.2-synopsis: Functions involving lists of Either-description: Functions involving lists of Either-category: Data-homepage: https://github.com/chris-martin/either-list-functions#readme-bug-reports: https://github.com/chris-martin/either-list-functions/issues-author: Chris Martin <ch.martin@gmail.com>-maintainer: Chris Martin <ch.martin@gmail.com>-license: Apache-2.0-license-file: license.txt-build-type: Simple-cabal-version: >= 1.10+name: either-list-functions+version: 0.0.4.8+category: Data+synopsis: Functions involving lists of Either +description: Functions involving lists of Either.++homepage: https://github.com/typeclasses/either-list-functions+bug-reports: https://github.com/typeclasses/either-list-functions/issues++author: Chris Martin <ch.martin@gmail.com>+maintainer: Chris Martin, Julie Moronuki++license: Apache-2.0+license-file: license.txt++extra-source-files: *.md+ source-repository head- type: git- location: https://github.com/chris-martin/either-list-functions+ type: git+ location: https://github.com/typeclasses/either-list-functions +common base+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ , base ^>= 4.18 || ^>= 4.19+ library- hs-source-dirs:- src- ghc-options: -Wall- build-depends:- base >=4.9 && <4.11- exposed-modules:- Data.List.EitherFunctions- other-modules:- Paths_either_list_functions- default-language: Haskell2010+ import: base+ hs-source-dirs: src+ exposed-modules: Data.List.EitherFunctions+ build-depends:+ , containers ^>= 0.6.4 test-suite doctest- type: exitcode-stdio-1.0- main-is: doctest.hs- hs-source-dirs:- test- ghc-options: -Wall -threaded- build-depends:- base >=4.9 && <4.11- , doctest- , either-list-functions- other-modules:- Paths_either_list_functions- default-language: Haskell2010+ import: base+ type: exitcode-stdio-1.0+ main-is: doctest.hs+ ghc-options: -threaded+ hs-source-dirs: test+ build-depends:+ , doctest ^>= 0.22 || ^>= 0.23+ , either-list-functions
license.txt view
@@ -1,4 +1,4 @@-Copyright 2017 Chris Martin+Copyright 2017-2021 Mission Valley Software LLC Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.
src/Data/List/EitherFunctions.hs view
@@ -1,67 +1,285 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE BlockArguments, LambdaCase, NoImplicitPrelude #-} +-- | Functions involving lists of 'Either'.+ module Data.List.EitherFunctions- ( partlyMap- , groupEither- , spanLeft- , spanRight- ) where+ ( -import Data.Either (Either (..))-import Data.List (map)-import Data.Maybe (Maybe (..), maybe)+ {- * 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 = 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 )++-- |+-- >>> 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 = 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 "Vertebrates"+-- >>> , p "Cats"+-- >>> , p "Snakes"+-- >>> , section "Invertebrates"+-- >>> , 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+-- |+-- +- Vertebrates: Cats, Snakes+-- |+-- `- Invertebrates: 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