packages feed

non-empty (empty) → 0.0

raw patch · 7 files changed

+612/−0 lines, 7 filesdep +QuickCheckdep +basedep +utility-htsetup-changed

Dependencies added: QuickCheck, base, utility-ht

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Henning Thielemann 2012++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ non-empty.cabal view
@@ -0,0 +1,70 @@+Name:             non-empty+Version:          0.0+License:          BSD3+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         http://code.haskell.org/~thielema/non-empty/+Category:         Data+Synopsis:         List-like structures with static checks on the number of elements+Description:+  We provide a data type that allows to store a list-like structure+  with at least or exactly @n@ elements,+  where @n@ is fixed in the type in a kind of Peano encoding+  and is usually small.+  The datatype is intended to increase safety+  by making functions total that are partial on plain lists.+  E.g. on a non-empty list, 'head' and 'tail' are always defined.+  .+  The package uses Haskell 98.+  .+  Similar packages:+  .+  * @NonEmptyList@:+    restricted to lists, minimum number of elements: 1+  .+  * @NonEmpty@:+    restricted to lists, minimum number of elements: 1,+    designed for unqualified use of identifiers+  .+  * @Cardinality@:@NeverEmptyList@+  .+  * <http://www.haskell.org/haskellwiki/Non-empty_list>+  .+  Related packages:+  .+  * @Stream@:+    Lists that contain always infinitely many elements.+  .+  * @fixed-list@:+    Uses the same data structure as this package+    but is intended for fixing the number of elements in a list.+    Requires multi-parameter type classes with functional dependencies.++Tested-With:      GHC==7.4.1+Cabal-Version:    >=1.6+Build-Type:       Simple++Source-Repository this+  Tag:         0.0+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/non-empty++Source-Repository head+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/non-empty++Library+  Build-Depends:+    utility-ht >= 0.0.1 && <0.1,+    QuickCheck >= 2.1 && <3+  Build-Depends: base >= 4 && < 5++  GHC-Options:      -Wall+  Hs-Source-Dirs:   src+  Exposed-Modules:+    Data.NonEmpty+    Data.NonEmpty.Class+    Data.NonEmpty.Mixed+  Other-Modules:+    Data.NonEmptyPrivate
+ src/Data/NonEmpty.hs view
@@ -0,0 +1,33 @@+module Data.NonEmpty (+   T(Cons, head, tail),+   (!:),+   force,+   apply,+   bind,+   Empty(Empty),+   toList,+   flatten,+   fetch,+   cons,+   singleton,+   reverse,+   mapHead,+   mapTail,+   init,+   last,+   foldl1,+   maximum,+   minimum,+   sum,+   product,+   append,+   cycle,+   zipWith,+   sortBy,+   sort,+   insertBy,+   insert,+   ) where++import Data.NonEmptyPrivate+import Prelude ()
+ src/Data/NonEmpty/Class.hs view
@@ -0,0 +1,117 @@+module Data.NonEmpty.Class where++import qualified Data.List as List+import Control.Monad (liftM2, )+import Data.Tuple.HT (forcePair, mapSnd, )+import qualified Data.List.HT as ListHT++import qualified Test.QuickCheck as QC++import Prelude hiding (zipWith, )+++class Empty f where+   empty :: f a++instance Empty [] where+   empty = []++instance Empty Maybe where+   empty = Nothing+++class Cons f where+   cons :: a -> f a -> f a++instance Cons [] where+   cons = (:)+++class View f where+   viewL :: f a -> Maybe (a, f a)++instance View [] where+   viewL = ListHT.viewL++instance View Maybe where+   viewL = fmap (\a -> (a, Nothing))+++class Singleton f where+   singleton :: a -> f a++instance Singleton [] where+   singleton x = [x]++instance Singleton Maybe where+   singleton x = Just x+++class Append f where+   append :: f a -> f a -> f a++instance Append [] where+   append = (++)++infixr 5 `cons`, `append`+++class Zip f where+   zipWith :: (a -> b -> c) -> f a -> f b -> f c++instance Zip [] where+   zipWith = List.zipWith++instance Zip Maybe where+   zipWith = liftM2++zip :: (Zip f) => f a -> f b -> f (a,b)+zip = zipWith (,)+++class Sort f where+   sortBy :: (a -> a -> Ordering) -> f a -> f a+   insertBy :: (a -> a -> Ordering) -> a -> f a -> (a, f a)++instance Sort [] where+   sortBy = List.sortBy+   insertBy f y xt =+      forcePair $+      case xt of+         [] -> (y, xt)+         x:xs ->+            case f y x of+               GT -> (x, List.insertBy f y xs)+               _ -> (y, xt)++instance Sort Maybe where+   sortBy _f = id+   insertBy f y mx =+      forcePair $+      case mx of+         Nothing -> (y, Nothing)+         Just x ->+            mapSnd Just $+            case f y x of+               GT -> (x, y)+               _ -> (y, x)++sort :: (Ord a, Sort f) => f a -> f a+sort = sortBy compare++{- |+Insert an element into an ordered list while preserving the order.+The first element of the resulting list is returned individually.+We need this for construction of a non-empty list.+-}+insert :: (Ord a, Sort f) => a -> f a -> (a, f a)+insert = insertBy compare+++class Arbitrary f where+   arbitrary :: QC.Arbitrary a => QC.Gen (f a)+   shrink :: QC.Arbitrary a => f a -> [f a]++instance Arbitrary [] where+   arbitrary = QC.arbitrary+   shrink = QC.shrink
+ src/Data/NonEmpty/Mixed.hs view
@@ -0,0 +1,104 @@+{- |+Functions that cope both with plain and non-empty structures.+-}+module Data.NonEmpty.Mixed (+   module Data.NonEmpty.Mixed,+   Priv.appendRight) where++import qualified Data.NonEmpty.Class as C+import qualified Data.NonEmptyPrivate as Priv+import qualified Data.NonEmpty as NonEmpty+import Data.Foldable (Foldable, foldr, )++import Prelude hiding (foldr, )+++groupBy ::+   (Foldable f) =>+   (a -> a -> Bool) -> f a -> [NonEmpty.T [] a]+groupBy p =+   foldr+      (\x0 yt ->+         let (xr,yr) =+               case yt of+                  NonEmpty.Cons x1 xs : ys ->+                     if p x0 x1+                       then (x1:xs,ys)+                       else ([],yt)+                  [] -> ([],yt)+         in  NonEmpty.Cons x0 xr : yr)+      []++segmentBefore ::+   (Foldable f) =>+   (a -> Bool) -> f a -> ([a], [NonEmpty.T [] a])+segmentBefore p =+   foldr+      (\ x ys ->+         if p x+           then ([], NonEmpty.Cons x (fst ys) : snd ys)+           else (x : fst ys, snd ys))+      ([],[])++scanl :: (a -> b -> a) -> a -> [b] -> NonEmpty.T [] a+scanl f =+   let go a bt =+          NonEmpty.Cons a $+          case bt of+             [] -> []+             b:bs -> NonEmpty.flatten $ go (f a b) bs+   in  go++{-+Fusable and generic, but not as lazy as 'scanl'.+-}+genericScanl ::+   (Foldable f) =>+   (a -> b -> a) -> a -> f b -> NonEmpty.T [] a+genericScanl f a0 xs =+   NonEmpty.force $+   foldr+      (\ b go a ->+          NonEmpty.Cons a $ NonEmpty.flatten $ go $ f a b)+      (\ a -> NonEmpty.Cons a [])+      xs+      a0+++insertBy ::+   (C.Sort f) =>+   (a -> a -> Ordering) -> a -> f a -> NonEmpty.T f a+insertBy f y xs = uncurry NonEmpty.Cons $ C.insertBy f y xs++insert :: (Ord a, C.Sort f) => a -> f a -> NonEmpty.T f a+insert = insertBy compare+++infixl 5 `appendLeft`++appendLeft ::+   (C.Append f, C.View f, C.Cons f) =>+   f a -> NonEmpty.T f a -> NonEmpty.T f a+appendLeft xt yt =+   NonEmpty.force $+   case C.viewL xt of+      Nothing -> yt+      Just (x,xs) -> NonEmpty.Cons x $ C.append xs $ NonEmpty.flatten yt++tails ::+   (C.View f, C.Empty f) =>+   f a -> NonEmpty.T [] (f a)+tails xt =+   NonEmpty.force $+   case C.viewL xt of+      Nothing -> NonEmpty.Cons C.empty []+      Just (_, xs) -> NonEmpty.cons xt $ tails xs++inits ::+   (C.View f, C.Cons f, C.Empty f) =>+   f a -> NonEmpty.T [] (f a)+inits xt =+   NonEmpty.Cons C.empty $+   case C.viewL xt of+      Nothing -> []+      Just (x,xs) -> map (C.cons x) $ NonEmpty.flatten $ inits xs
+ src/Data/NonEmptyPrivate.hs view
@@ -0,0 +1,258 @@+module Data.NonEmptyPrivate where++import qualified Data.NonEmpty.Class as C++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import Data.Traversable (Traversable, )+import Data.Foldable (Foldable, )+import Control.Monad (Monad, return, (=<<), )+import Control.Applicative (Applicative, liftA2, pure, (<*>), )++import Data.Functor (Functor, fmap, )+import Data.Function (flip, const, ($), (.), )+import Data.Maybe (Maybe(Just, Nothing), maybe, )+import Data.Ord (Ord, Ordering(GT), compare, )+import Data.Tuple.HT (forcePair, )+import qualified Prelude as P+import Prelude (Eq, Show, Num, uncurry, )++import qualified Test.QuickCheck as QC+++{-+We could also have (:!) as constructor,+but in order to import it unqualified we have to import 'T' unqualified, too,+and this would cause name clashes with locally defined types with name @T@.+-}+{- |+The type 'T' can be used for many kinds of list-like structures+with restrictions on the size.++* @T [] a@ is a lazy list containing at least one element.++* @T (T []) a@ is a lazy list containing at least two elements.++* @T Vector a@ is a vector with at least one element.+  You may also use unboxed vectors but the first element will be stored in a box+  and you will not be able to use many functions from this module.++* @T Maybe a@ is a list that contains one or two elements.++* @T Empty a@ is a list that contains exactly one element.++* @T (T Empty) a@ is a list that contains exactly two elements.+-}+data T f a = Cons { head :: a, tail :: f a }+   deriving (Eq, Ord, Show)+++infixr 5 !:, `append`, `appendRight`++(!:) :: a -> f a -> T f a+(!:) = Cons+++{- |+Force immediate generation of Cons.+-}+force :: T f a -> T f a+force x = Cons (head x) (tail x)+++instance Functor f => Functor (T f) where+   fmap f (Cons x xs) = f x !: fmap f xs++instance Foldable f => Foldable (T f) where+   foldr f y (Cons x xs) = f x $ Fold.foldr f y xs+   foldl1 = foldl1+   foldr1 f (Cons x xs) =+      maybe x (f x) $+      Fold.foldr (\y -> Just . maybe y (f y)) Nothing xs+{-+   foldr1 f (Cons x xs) =+      case xs of+         [] -> x+         y:ys -> f x $ Fold.foldr1 f (Cons y ys)+-}+++instance Traversable f => Traversable (T f) where+   sequenceA (Cons x xs) = liftA2 Cons x $ Trav.sequenceA xs++instance+   (Applicative f, C.Empty f, C.Cons f, C.Append f) =>+      Applicative (T f) where+   pure = singleton+   (<*>) = apply++instance (Monad f, C.Empty f, C.Cons f, C.Append f) =>+      Monad (T f) where+   return = singleton+   (>>=) = bind++instance (QC.Arbitrary a, C.Arbitrary f) => QC.Arbitrary (T f a) where+   arbitrary = liftA2 Cons QC.arbitrary C.arbitrary+   shrink (Cons x xs) = fmap (\(y, Aux ys) -> Cons y ys) $ QC.shrink (x, Aux xs)++newtype Aux f a = Aux (f a)++instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (Aux f a) where+   arbitrary = fmap Aux C.arbitrary+   shrink (Aux x) = fmap Aux $ C.shrink x++{- |+Implementation of 'Applicative.<*>' without the 'C.Empty' constraint+that is needed for 'Applicative.pure'.+-}+apply ::+   (Applicative f, C.Cons f, C.Append f) =>+   T f (a -> b) -> T f a -> T f b+apply (Cons f fs) (Cons x xs) =+   Cons (f x) (fmap f xs `C.append` (fs <*> C.cons x xs))++{- |+Implementation of 'Monad.>>=' without the 'C.Empty' constraint+that is needed for 'Monad.return'.+-}+bind ::+   (Monad f, C.Cons f, C.Append f) =>+   T f a -> (a -> T f b) -> T f b+bind (Cons x xs) k =+   appendRight (k x) (flatten . k =<< xs)+++data Empty a = Empty+   deriving (Eq, Ord, Show)++instance Functor Empty where+   fmap _ Empty = Empty++instance Foldable Empty where+   foldr _ y Empty = y++instance Traversable Empty where+   sequenceA Empty = pure Empty++instance C.View Empty where+   viewL _ = Nothing++instance QC.Arbitrary (Empty a) where+   arbitrary = return Empty+   shrink _ = []+++toList :: Foldable f => T f a -> [a]+toList (Cons x xs) = x : Fold.toList xs++flatten :: C.Cons f => T f a -> f a+flatten (Cons x xs) = C.cons x xs++fetch :: C.View f => f a -> Maybe (T f a)+fetch = fmap (uncurry Cons) . C.viewL+++instance C.Cons f => C.Cons (T f) where+   cons = cons++cons :: C.Cons f => a -> T f a -> T f a+cons x0 (Cons x1 xs) = x0 !: C.cons x1 xs+++instance C.Empty Empty where+   empty = Empty++instance C.Empty f => C.Singleton (T f) where+   singleton = singleton++singleton :: C.Empty f => a -> T f a+singleton x = x !: C.empty++reverse :: (Foldable f, C.Cons f, C.Empty f) => T f a -> T f a+reverse (Cons x xs) =+   Fold.foldl (flip cons) (singleton x) xs++mapHead :: (a -> a) -> T f a -> T f a+mapHead f (Cons x xs) = f x !: xs++mapTail :: (f a -> g a) -> T f a -> T g a+mapTail f (Cons x xs) = x !: f xs++init :: (C.Zip f, C.Cons f) => T f a -> f a+init (Cons x xs) = C.zipWith const (C.cons x xs) xs++last :: (Foldable f) => T f a -> a+last = foldl1 (flip const)++foldl1 :: (Foldable f) => (a -> a -> a) -> T f a -> a+foldl1 f (Cons x xs) = Fold.foldl f x xs+++-- | maximum is a total function+maximum :: (Ord a, Foldable f) => T f a -> a+maximum = foldl1 P.max++-- | minimum is a total function+minimum :: (Ord a, Foldable f) => T f a -> a+minimum = foldl1 P.min++-- | sum does not need a zero for initialization+sum :: (Num a, Foldable f) => T f a -> a+sum = foldl1 (P.+)++-- | product does not need a one for initialization+product :: (Num a, Foldable f) => T f a -> a+product = foldl1 (P.*)+++instance (C.Cons f, C.Append f) => C.Append (T f) where+   append = append++append :: (C.Cons f, C.Append f) => T f a -> T f a -> T f a+append xs ys = appendRight xs (flatten ys)++appendRight :: (C.Append f) => T f a -> f a -> T f a+appendRight (Cons x xs) ys = Cons x (C.append xs ys)++cycle :: (C.Cons f, C.Append f) => T f a -> T f a+cycle x =+   let y = append x y+   in  y+++instance (C.Zip f) => C.Zip (T f) where+   zipWith = zipWith++zipWith :: (C.Zip f) => (a -> b -> c) -> T f a -> T f b -> T f c+zipWith f (Cons a as) (Cons b bs) = Cons (f a b) (C.zipWith f as bs)+++instance (C.Sort f) => C.Sort (T f) where+   sortBy = sortBy+   insertBy f y xt@(Cons x xs) =+      forcePair $+      case f y x of+         GT -> (x, uncurry Cons $ C.insertBy f y xs)+         _ -> (y, xt)++{- |+If you nest too many non-empty lists+then the efficient merge-sort (linear-logarithmic runtime)+will degenerate to an inefficient insert-sort (quadratic runtime).+-}+sortBy :: (C.Sort f) => (a -> a -> Ordering) -> T f a -> T f a+sortBy f (Cons x xs) =+   uncurry Cons $ C.insertBy f x $ C.sortBy f xs++sort :: (Ord a, C.Sort f) => T f a -> T f a+sort = sortBy compare++insertBy ::+   (C.Sort f, C.Cons f) =>+   (a -> a -> Ordering) -> a -> T f a -> T f a+insertBy f y = uncurry cons . C.insertBy f y++insert ::+   (Ord a, C.Sort f, C.Cons f) =>+   a -> T f a -> T f a+insert = insertBy compare