kleene-list (empty) → 0.1.0.0
raw patch · 8 files changed
+926/−0 lines, 8 filesdep +QuickCheckdep +basedep +base-compatbuild-type:Customsetup-changed
Dependencies added: QuickCheck, base, base-compat, deepseq, doctest, kleene-list, template-haskell
Files
- LICENSE +201/−0
- README.md +0/−0
- Setup.hs +7/−0
- doctest/doctests.hs +14/−0
- kleene-list.cabal +53/−0
- src/Data/List/Kleene/Internal.hs +368/−0
- src/Data/List/Kleene/Plus.hs +152/−0
- src/Data/List/Kleene/Star.hs +131/−0
+ LICENSE view
@@ -0,0 +1,201 @@+Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
+ Setup.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests"
+ doctest/doctests.hs view
@@ -0,0 +1,14 @@+module Main where++import Build_doctests (flags, pkgs, module_sources)+import Data.Foldable (traverse_)+import System.Environment.Compat (unsetEnv)+import Test.DocTest (doctest)++main :: IO ()+main = do+ traverse_ putStrLn args+ unsetEnv "GHC_ENVIRONMENT"+ doctest args+ where+ args = flags ++ pkgs ++ module_sources
+ kleene-list.cabal view
@@ -0,0 +1,53 @@+cabal-version: >=1.10++name: kleene-list+version: 0.1.0.0+synopsis: A list type based on the Kleene star and plus.+description: This package provides a simple list type which is defined mutually with a non-empty list type. This makes interop between the two simpler. The types take their names from the Kleene star and plus. +license: Apache+license-file: LICENSE+author: Donnacha Oisín Kidney+maintainer: mail@doisinkidney.com+copyright: 2020 Donnacha Oisín Kidney+category: Data+build-type: Custom+extra-source-files: README.md++source-repository head+ type: git+ location: https://github.com/oisdk/kleene-list++custom-setup+ setup-depends:+ base+ , Cabal+ , cabal-doctest >=1.0.6 && <1.1++library+ exposed-modules:+ Data.List.Kleene.Internal+ Data.List.Kleene.Star+ Data.List.Kleene.Plus+ hs-source-dirs:+ src+ ghc-options: -Wall -fwarn-incomplete-record-updates -fwarn-redundant-constraints -Wcompat+ build-depends:+ base >=4.7 && <5+ , deepseq+ default-language: Haskell2010++test-suite doctests+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ hs-source-dirs:+ doctest+ ghc-options: -Wall -fwarn-incomplete-record-updates -fwarn-redundant-constraints -Wcompat -threaded+ build-depends:+ QuickCheck+ , base+ , base-compat+ , deepseq+ , doctest+ , kleene-list+ , template-haskell+ default-language: Haskell2010
+ src/Data/List/Kleene/Internal.hs view
@@ -0,0 +1,368 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Data.List.Kleene.Internal+-- Description : Common utility functions and definitions for the kleene-list package.+-- Copyright : (c) Donnacha Oisín Kidney, 2020+-- License : Apache+-- Maintainer : mail@doisinkidney.com+-- Stability : experimental+-- Portability : ghc+--+-- = WARNING+--+-- This module is considered __internal__.+--+-- The Package Versioning Policy __does not apply__.+--+-- This contents of this module may change __in any way whatsoever__+-- and __without any warning__ between minor versions of this package.+--+-- Authors importing this module are expected to track development+-- closely.++{-# OPTIONS_HADDOCK not-home #-}+module Data.List.Kleene.Internal where++import Control.DeepSeq (NFData (rnf))+import Data.Data (Data, Typeable)+import Data.Functor.Classes+import GHC.Generics (Generic)++import GHC.Exts (IsList)+import qualified GHC.Exts++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Zip+import Data.Foldable++import Prelude hiding (filter, head, scanl, scanr, tail)++-- | A list, based on the Kleene star.+-- This type is isomorphic to Haskell's standard @[]@ type, so it can be used+-- in the same way.+data Star a+ = Nil+ | Cons (Plus a)+ deriving (Eq, Ord, Generic, Data, Typeable, Functor, Traversable)++infixr 5 :-+-- | A non-empty list type, based on the Kleene plus.+-- This type is isomorphic to 'Data.List.NonEmpty.NonEmpty' type, so it+-- can be used in the same way.+data Plus a+ = (:-)+ { head :: a+ , tail :: Star a+ } deriving (Eq, Ord, Generic, Data, Typeable, Functor, Traversable)++instance Foldable Star where+ foldr _ b Nil = b+ foldr f b (Cons xs) = foldr f b xs++ foldl _ b Nil = b+ foldl f b (Cons xs) = foldl f b xs++ foldl' _ !b Nil = b+ foldl' f !b (Cons xs) = foldl' f b xs++ foldl1 _ Nil = errorWithoutStackTrace "foldl1: empty list"+ foldl1 f (Cons xs) = foldl1 f xs++ foldr1 _ Nil = errorWithoutStackTrace "foldr1: empty list"+ foldr1 f (Cons xs) = foldr1 f xs++ foldMap _ Nil = mempty+ foldMap f (Cons xs) = foldMap f xs++ minimum Nil = errorWithoutStackTrace "minimum: empty list"+ minimum (Cons xs) = minimum xs++ maximum Nil = errorWithoutStackTrace "maximum: empty list"+ maximum (Cons xs) = maximum xs++instance Foldable Plus where+ foldr f b ~(x :- xs) = f x (foldr f b xs)++ foldl f b ~(x :- xs) = foldl f (f b x) xs++ foldl' f !b ~(x :- xs) = foldl' f (f b x) xs++ foldl1 f ~(x :- xs) = foldl f x xs++ foldr1 f = go+ where+ go (x :- xs) = case xs of+ Nil -> x+ Cons ys -> f x (go ys)++ foldMap f ~(x :- xs) = f x <> foldMap f xs++ null _ = False++ minimum = foldr1 min+ maximum = foldr1 max++instance Eq1 Star where+ liftEq _ Nil Nil = True+ liftEq eq (Cons xs) (Cons ys) = liftEq eq xs ys+ liftEq _ _ _ = False++instance Eq1 Plus where+ liftEq eq ~(x :- xs) (y :- ys) = eq x y && liftEq eq xs ys++instance Ord1 Star where+ liftCompare _ Nil Nil = EQ+ liftCompare _ Nil (Cons _) = LT+ liftCompare _ (Cons _) Nil = GT+ liftCompare c (Cons xs) (Cons ys) = liftCompare c xs ys++instance Ord1 Plus where+ liftCompare c ~(x :- xs) ~(y :- ys) = c x y <> liftCompare c xs ys++instance Show1 Plus where+ liftShowsPrec _ sp _ = sp . foldr (:) []++instance Show1 Star where+ liftShowsPrec _ sp _ = sp . foldr (:) []++-- | A pattern for building up star lists as cons-lists.+--+-- >>> 1 :* 2 :* 3 :* Nil+-- [1,2,3]+infixr 5 :*+pattern (:*) :: a -> Star a -> Star a+pattern (:*) x xs = Cons (x :- xs)+{-# COMPLETE (:*), Nil #-}++-- | A pattern for building up plus lists as cons-lists.+--+-- >>> 1 :+ 2 :+ One 3+-- [1,2,3]+infixr 5 :++pattern (:+) :: a -> Plus a -> Plus a+pattern (:+) x xs = x :- Cons xs++-- | A pattern for a singleton plus list.+pattern One :: a -> Plus a+pattern One x = x :- Nil+{-# COMPLETE (:+), One #-}++instance IsList (Star a) where+ type Item (Star a) = a+ fromList = foldr (:*) Nil+ toList = foldr (:) []++instance IsList (Plus a) where+ type Item (Plus a) = a+ fromList [] = errorWithoutStackTrace "Cannot make plus from empty list"+ fromList (x:xs) = x :- GHC.Exts.fromList xs+ toList = foldr (:) []++instance Show a => Show (Star a) where+ showsPrec n = showsPrec n . toList++instance Show a => Show (Plus a) where+ showsPrec n = showsPrec n . toList++instance NFData a => NFData (Star a) where+ rnf Nil = ()+ rnf (Cons xs) = rnf xs++instance NFData a => NFData (Plus a) where+ rnf (x :- xs) = rnf x `seq` rnf xs++instance Semigroup (Plus a) where+ ~(x :- xs) <> ys = x :+ (xs *<>+ ys)++(*<>+) :: Star a -> Plus a -> Plus a+Nil *<>+ ys = ys+Cons xs *<>+ ys = xs <> ys++instance Semigroup (Star a) where+ Nil <> ys = ys+ Cons xs <> ys = Cons (xs +<>* ys)++(+<>*) :: Plus a -> Star a -> Plus a+~(x :- xs) +<>* ys = x :- (xs <> ys)++instance Monoid (Star a) where+ mempty = Nil++instance Applicative Star where+ pure = Cons . pure++ Nil <*> _ = Nil+ f :* fs <*> xs = foldr ((:*) . f) (fs <*> xs) xs++ liftA2 _ Nil _ = Nil+ liftA2 f (x :* xs) ys = foldr ((:*) . f x) (liftA2 f xs ys) ys++-- |+-- >>> (,) <$> (1 :+ 2 :+ One 3) <*> ('a' :+ 'b' :+ One 'c')+-- [(1,'a'),(1,'b'),(1,'c'),(2,'a'),(2,'b'),(2,'c'),(3,'a'),(3,'b'),(3,'c')]+--+-- >>> liftA2 (,) (1 :+ 2 :+ One 3) ('a' :+ 'b' :+ One 'c')+-- [(1,'a'),(1,'b'),(1,'c'),(2,'a'),(2,'b'),(2,'c'),(3,'a'),(3,'b'),(3,'c')]+instance Applicative Plus where+ pure = One++ ~(f' :- fs') <*> xs = f' (head xs) :- foldr ((:*) . f') (go fs') (tail xs)+ where+ go Nil = Nil+ go (f :* fs) = foldr ((:*) . f) (go fs) xs++ liftA2 f ~(x' :- xs') ys = f x' (head ys) :- foldr ((:*) . f x') (go xs') (tail ys)+ where+ go Nil = Nil+ go (x :* xs) = foldr ((:*) . f x) (go xs) ys++instance Monad Star where+ xs >>= f = foldr ((<>) . f) Nil xs++instance Monad Plus where+ ~(x :- xs) >>= f = f x +<>* go xs+ where+ go Nil = Nil+ go (Cons ys) = Cons (ys >>= f)++instance Alternative Star where+ (<|>) = (<>)+ empty = Nil++instance MonadPlus Star++instance MonadFix Plus where+ mfix f = case fix (f . head) of+ ~(x :- _) -> x :- mfix (tail . f)++instance MonadFix Star where+ mfix f = case fix (f . head . unStar) of+ Nil -> Nil+ (x :* _) -> x :* mfix (tail . unStar . f)+ where+ unStar ~(Cons xs) = xs++instance MonadZip Plus where+ mzip ~(x :- xs) ~(y :- ys) = (x, y) :- mzip xs ys++ mzipWith f ~(x :- xs) ~(y :- ys) = f x y :- mzipWith f xs ys++ munzip ~(~(y,z) :- xs) = (y :- ys, z :- zs)+ where+ ~(ys,zs) = munzip xs++instance MonadZip Star where+ mzip Nil _ = Nil+ mzip _ Nil = Nil+ mzip (Cons xs) (Cons ys) = Cons (mzip xs ys)++ mzipWith _ Nil _ = Nil+ mzipWith _ _ Nil = Nil+ mzipWith f (Cons xs) (Cons ys) = Cons (mzipWith f xs ys)++ munzip Nil = (Nil, Nil)+ munzip (Cons xs) = (Cons ys, Cons zs)+ where+ ~(ys,zs) = munzip xs++merge :: (a -> a -> Ordering) -> Star a -> Star a -> Star a+merge _ Nil ys = ys+merge cmp (Cons xs) ys = Cons (mergel cmp xs ys)++mergel :: (a -> a -> Ordering) -> Plus a -> Star a -> Plus a+mergel _ xs Nil = xs+mergel cmp xs (Cons ys) = mergelr cmp xs ys++merger :: (a -> a -> Ordering) -> Star a -> Plus a -> Plus a+merger _ Nil ys = ys+merger cmp (Cons xs) ys = mergelr cmp xs ys++mergelr :: (a -> a -> Ordering) -> Plus a -> Plus a -> Plus a+mergelr cmp xss@ ~(x :- xs) yss@ ~(y :- ys) = case cmp x y of+ LT -> x :+ merger cmp xs yss+ EQ -> x :+ y :- merge cmp xs ys+ GT -> y :+ mergel cmp xss ys++treeFoldMap :: (a -> b) -> (b -> b -> b) -> Plus a -> b+treeFoldMap c f = go+ where+ go (One x) = c x+ go (x :+ y :- xs) = go' (f (c x) (c y) :- pairMap xs)++ pairMap (x1 :* x2 :* xs) = f (c x1) (c x2) :* pairMap xs+ pairMap (x1 :* Nil) = c x1 :* Nil+ pairMap Nil = Nil++ go' (One x) = x+ go' (x :+ y :- xs) = go' (f x y :- pairMap' xs)++ pairMap' (x1 :* x2 :* xs) = f x1 x2 :* pairMap' xs+ pairMap' xs = xs++-- |+-- >>> prescanlPlus (+) 0 [1,2,3]+-- [1,3,6]+prescanlPlus :: (b -> a -> b) -> b -> Plus a -> Plus b+prescanlPlus f b (x :- xs) = scanl f (f b x) xs++-- |+-- >>> prescanlStar (+) 0 [1,2,3]+-- [1,3,6]+prescanlStar :: (b -> a -> b) -> b -> Star a -> Star b+prescanlStar _ _ Nil = Nil+prescanlStar f b (Cons xs) = Cons (prescanlPlus f b xs)++-- | Functions the same as 'Data.List.scanl' in "Data.List".+--+-- >>> scanl (+) 0 [1,2,3]+-- [0,1,3,6]+scanl :: (b -> a -> b) -> b -> Star a -> Plus b+scanl f b xs = b :- prescanlStar f b xs++-- | Functions the same as 'Data.List.scanr' in "Data.List".+--+-- >>> scanr (+) 0 ([1,2,3] :: Star Int)+-- [6,5,3,0]+scanr :: Foldable f => (a -> b -> b) -> b -> f a -> Plus b+scanr f b = foldr (\x xs -> f x (head xs) :+ xs) (One b)++-- | Functions the same as 'Data.List.filter' in "Data.List".+--+-- >>> filter even ([1..5] :: Star Int)+-- [2,4]+filter :: Foldable f => (a -> Bool) -> f a -> Star a+filter p = foldr f Nil+ where+ f x xs+ | p x = x :* xs+ | otherwise = xs++takeStar :: Int -> Star a -> Star a+takeStar _ Nil = Nil+takeStar i (Cons xs) = takePlus i xs++takePlus :: Int -> Plus a -> Star a+takePlus 0 _ = Nil+takePlus i ~(x :- xs) = x :* takeStar (i-1) xs++indexPlus :: Plus a -> Int -> a+indexPlus xs 0 = head xs+indexPlus xs i = indexStar (tail xs) (i-1)++indexStar :: Star a -> Int -> a+indexStar Nil _ = errorWithoutStackTrace "index: empty list!"+indexStar (Cons xs) i = indexPlus xs i+++-- $setup+-- >>> :set -XOverloadedLists
+ src/Data/List/Kleene/Plus.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Data.List.Kleene.Star+-- Description : A list type isomorphic to 'Data.List.NonEmpty.NonEmpty' based on the Kleene plus.+-- Copyright : (c) Donnacha Oisín Kidney, 2020+-- License : Apache+-- Maintainer : mail@doisinkidney.com+-- Stability : experimental+-- Portability : ghc+--+-- This module provides a simple list type isomorphic to 'Data.List.NonEmpty.NonEmpty',+-- but which is defined in terms of a possibly empty list+-- type. This can make moving between one type and another+-- easier.++module Data.List.Kleene.Plus+ ( -- * The list type+ Plus(..)+ ,pattern (:+)+ ,pattern One+ ,Star(..)+ -- * Utility functions+ ,last+ ,filter+ ,reverse+ ,take+ ,(!!)+ -- * Building lists+ ,unfoldr+ ,iterate+ ,cycle+ -- * scans+ ,scanr+ ,scanl+ ,prescanr+ ,prescanl+ -- * Sorting+ ,sortBy+ ,sortOn+ ,sort+ )+ where++import Data.List.Kleene.Internal++import Data.Ord++import Prelude hiding (cycle, filter, head, iterate,+ last, reverse, scanl, scanr, take,+ (!!))++-- | Sort given a comparison function. Stable.+-- \(\mathcal{O}(n \log n)\).+--+-- >>> sortBy (\x y -> compare (fst x) (fst y)) [(4,1),(3,2),(1,3),(3,4)]+-- [(1,3),(3,2),(3,4),(4,1)]+sortBy :: (a -> a -> Ordering) -> Plus a -> Plus a+sortBy cmp = treeFoldMap One (mergelr cmp)++-- | Sort given a selector function. Stable.+-- \(\mathcal{O}(n \log n)\).+--+-- >>> sortOn fst [(4,1),(3,2),(1,3),(3,4)]+-- [(1,3),(3,2),(3,4),(4,1)]+sortOn :: Ord b => (a -> b) -> Plus a -> Plus a+sortOn c = fmap fst . treeFoldMap (\x -> One (x, c x)) (mergelr (comparing snd))++-- | Stable sort.+-- \(\mathcal{O}(n \log n)\).+--+-- >>> sort [4,3,1,3]+-- [1,3,3,4]+sort :: Ord a => Plus a -> Plus a+sort = sortBy compare++-- | Return the last element of a finite list.+--+-- >>> last [1..10]+-- 10+last :: Plus a -> a+last = foldl1 (\_ x -> x)++-- | Unfold a list from a seed.+unfoldr :: (b -> (a, Maybe b)) -> b -> Plus a+unfoldr f b = x :- maybe Nil (Cons . unfoldr f) xs+ where+ (x,xs) = f b++-- | Cycle a list infinitely+--+-- >>> take 10 (cycle [1..3])+-- [1,2,3,1,2,3,1,2,3,1]+cycle :: Plus a -> Plus a+cycle xs = ys+ where+ ys = xs <> ys++-- | Repeatedly apply a function, listing its output.+--+-- >>> take 5 (iterate (+1) 1)+-- [1,2,3,4,5]+iterate :: (a -> a) -> a -> Plus a+iterate f x = x :+ iterate f (f x)++-- | Like 'scanr', but without including the initial element in the output.+--+-- >>> prescanr (+) 0 [1,2,3]+-- [6,5,3]+prescanr :: (a -> b -> b) -> b -> Plus a -> Plus b+prescanr f b (One x) = One (f x b)+prescanr f b (x :+ xs) = f x (head ys) :+ ys+ where+ ys = prescanr f b xs++-- | Like 'scanl', but without including the initial element in the output.+--+-- >>> prescanl (+) 0 [1,2,3]+-- [1,3,6]+prescanl :: (b -> a -> b) -> b -> Plus a -> Plus b+prescanl = prescanlPlus++-- | Reverse a list.+--+-- >>> reverse [1..5]+-- [5,4,3,2,1]+reverse :: Plus a -> Plus a+reverse (x :- xs) = foldl (flip (:+)) (One x) xs++-- | @'take' n xs@ takes the first @n@ elements from @xs@.+--+-- >>> take 5 [1..]+-- [1,2,3,4,5]+--+-- >>> take 5 [1..3]+-- [1,2,3]+take :: Int -> Plus a -> Star a+take = takePlus++-- | Index into a list.+--+-- >>> [0..] !! 3+-- 3+--+-- >>> [0..5] !! 6+-- *** Exception: index: empty list!+(!!) :: Plus a -> Int -> a+(!!) = indexPlus++-- $setup+-- >>> :set -XOverloadedLists
+ src/Data/List/Kleene/Star.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Data.List.Kleene.Star+-- Description : A list type isomorphic to [] based on the Kleene star.+-- Copyright : (c) Donnacha Oisín Kidney, 2020+-- License : Apache+-- Maintainer : mail@doisinkidney.com+-- Stability : experimental+-- Portability : ghc+--+-- This module provides a simple list type isomorphic to Haskell's+-- standard @[]@, but which is defined in terms of a non-empty list+-- type. This can make moving between one type and another+-- easier.++module Data.List.Kleene.Star+ ( -- * The list type+ Star(..)+ ,pattern (:*)+ ,Plus(..)+ -- * Utility functions+ ,filter+ ,reverse+ ,uncons+ ,take+ ,(!!)+ -- * Building lists+ ,unfoldr+ -- * scans+ ,scanr+ ,scanl+ ,prescanl+ ,prescanr+ -- * Sorting+ ,sortBy+ ,sortOn+ ,sort+ )+ where++import Data.List.Kleene.Internal+import Data.Ord+import Prelude hiding (filter, head, reverse, scanl,+ scanr, take, (!!))++-- | Sort given a comparison function. Stable.+-- \(\mathcal{O}(n \log n)\).+--+-- >>> sortBy (\x y -> compare (fst x) (fst y)) [(4,1),(3,2),(1,3),(3,4)]+-- [(1,3),(3,2),(3,4),(4,1)]+sortBy :: (a -> a -> Ordering) -> Star a -> Star a+sortBy _ Nil = Nil+sortBy cmp (Cons xs) = Cons (treeFoldMap One (mergelr cmp) xs)++-- | Sort given a selector function. Stable.+-- \(\mathcal{O}(n \log n)\).+--+-- >>> sortOn fst [(4,1),(3,2),(1,3),(3,4)]+-- [(1,3),(3,2),(3,4),(4,1)]+sortOn :: Ord b => (a -> b) -> Star a -> Star a+sortOn _ Nil = Nil+sortOn c (Cons xs) = Cons (fmap fst (treeFoldMap (\x -> One (x, c x)) (mergelr (comparing snd)) xs))++-- | Stable sort.+-- \(\mathcal{O}(n \log n)\).+--+-- >>> sort [4,3,1,3]+-- [1,3,3,4]+sort :: Ord a => Star a -> Star a+sort = sortBy compare++-- | Unfold a list from a seed.+unfoldr :: (b -> Maybe (a, b)) -> b -> Star a+unfoldr f b = maybe Nil (\(x, xs) -> x :* unfoldr f xs) (f b)++-- | Like 'scanl', but without including the initial element in the output.+--+-- >>> prescanl (+) 0 [1,2,3]+-- [1,3,6]+prescanl :: (b -> a -> b) -> b -> Star a -> Star b+prescanl = prescanlStar++-- | Like 'scanr', but without including the initial element in the output.+--+-- >>> prescanr (+) 0 [1,2,3]+-- [6,5,3]+prescanr :: (a -> b -> b) -> b -> Star a -> Star b+prescanr _ _ Nil = Nil+prescanr f b (Cons xs) = Cons (go xs)+ where+ go (One x) = One (f x b)+ go (y :+ ys) = f y (head zs) :+ zs+ where+ zs = go ys++-- | Reverse a list.+--+-- >>> reverse [1..5]+-- [5,4,3,2,1]+reverse :: Star a -> Star a+reverse = foldl (flip (:*)) Nil++-- | Convert to a 'Plus' list.+uncons :: Star a -> Maybe (Plus a)+uncons Nil = Nothing+uncons (Cons xs) = Just xs++-- | @'take' n xs@ takes the first @n@ elements from @xs@.+--+-- >>> take 5 [1..]+-- [1,2,3,4,5]+--+-- >>> take 5 [1..3]+-- [1,2,3]+take :: Int -> Star a -> Star a+take = takeStar++-- | Index into a list.+--+-- >>> [0..] !! 3+-- 3+--+-- >>> [0..5] !! 6+-- *** Exception: index: empty list!+(!!) :: Star a -> Int -> a+(!!) = indexStar++-- $setup+-- >>> :set -XOverloadedLists