non-empty 0.1 → 0.1.1

raw patch · 3 files changed

+135/−2 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• non-empty.cabal +3/−2
• src/Data/NonEmptyPrivate.hs +10/−0
• src/Data/Optional.hs +122/−0

@@ -1,5 +1,5 @@ Name:             non-empty-Version:          0.1+Version:          0.1.1 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -50,7 +50,7 @@ Build-Type:       Simple  Source-Repository this-  Tag:         0.1+  Tag:         0.1.1   Type:        darcs   Location:    http://code.haskell.org/~thielema/non-empty @@ -71,5 +71,6 @@     Data.NonEmpty.Class     Data.NonEmpty.Mixed     Data.Empty+    Data.Optional   Other-Modules:     Data.NonEmptyPrivate

@@ -43,9 +43,19 @@  * @T Maybe a@ is a list that contains one or two elements. +* @Maybe@ is isomorphic to @Optional Empty@.+ * @T Empty a@ is a list that contains exactly one element.  * @T (T Empty) a@ is a list that contains exactly two elements.++* @Optional (T Empty) a@ is a list that contains zero or two elements.++* You can create a list type for every finite set of allowed list length+  by nesting Optional and NonEmpty constructors.+  If list length @n@ is allowed, then place @Optional@ at depth @n@,+  if it is disallowed then place @NonEmpty@.+  The maximm length is marked by @Empty@. -} data T f a = Cons { head :: a, tail :: f a }    deriving (Eq, Ord)

@@ -0,0 +1,122 @@+module Data.Optional (+   T(Nil, Cons),+   (?:),+   fromEmpty,+   fromNonEmpty,+   ) where++import qualified Data.NonEmpty.Class as C+import qualified Data.NonEmpty as NonEmpty+import qualified Data.Empty as Empty+import Data.NonEmptyPrivate (Aux(Aux), snocExtend)++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import Control.Applicative (pure, liftA2, )++import qualified Test.QuickCheck as QC++import Control.Monad (return, )+import Data.Functor (Functor, fmap, )+import Data.Function (($), (.), )+import Data.Ord (Ord, Ordering(GT), (>), )+import Data.Tuple.HT (mapSnd, )+import qualified Prelude as P+import Prelude (Eq, Show, Num, uncurry, )+++data T f a = Nil | Cons a (f a)+   deriving (Eq, Ord)++fromEmpty :: Empty.T a -> T f a+fromEmpty Empty.Cons = Nil++fromNonEmpty :: NonEmpty.T f a -> T f a+fromNonEmpty (NonEmpty.Cons x xs) = Cons x xs+++instance (C.Show f, P.Show a) => P.Show (T f a) where+   showsPrec = C.showsPrec++instance (C.Show f) => C.Show (T f) where+   showsPrec _ Nil = P.showString "Nil"+   showsPrec p (Cons x xs) =+      P.showParen (p>5) $+      P.showsPrec 6 x . P.showString "?:" . C.showsPrec 5 xs+++infixr 5 ?:++(?:) :: a -> f a -> T f a+(?:) = Cons+++instance P.Functor f => P.Functor (T f) where+   fmap _ Nil = Nil+   fmap f (Cons x xs) = Cons (f x) (fmap f xs)++instance (Fold.Foldable f) => Fold.Foldable (T f) where+   foldr _ y Nil = y+   foldr f y (Cons x xs) = f x (Fold.foldr f y xs)++instance (Trav.Traversable f) => Trav.Traversable (T f) where+   sequenceA Nil = pure Nil+   sequenceA (Cons x xs) = liftA2 Cons x (Trav.sequenceA xs)++instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (T f a) where+   arbitrary =+      QC.oneof+         [return Nil, liftA2 Cons QC.arbitrary C.arbitrary]+   shrink Nil = []+   shrink (Cons x xs) =+      P.map (\(y, Aux ys) -> Cons y ys) (QC.shrink (x, Aux xs))++instance C.Empty (T f) where+   empty = Nil++instance (C.Cons f, C.Empty f) => C.Cons (T f) where+   cons x Nil = Cons x C.empty+   cons x0 (Cons x1 xs) = Cons x0 $ C.cons x1 xs++instance (C.Repeat f) => C.Repeat (T f) where+   repeat x = Cons x $ C.repeat x++instance C.Zip f => C.Zip (T f) where+   zipWith f (Cons x xs) (Cons y ys) = Cons (f x y) (C.zipWith f xs ys)+   zipWith _ _ _ = Nil++instance (Trav.Traversable f, C.Reverse f) => C.Reverse (T f) where+   reverse Nil = Nil+   reverse (Cons x xs) =+      fromNonEmpty (snocExtend (C.reverse xs) x)++instance (NonEmpty.Insert f, C.Sort f) => C.Sort (T f) where+   sortBy _ Nil = Nil+   sortBy f (Cons x xs) =+      fromNonEmpty $ NonEmpty.insertBy f x $ C.sortBy f xs++instance (NonEmpty.Insert f) => NonEmpty.Insert (T f) where+   insertBy f y xt =+      uncurry NonEmpty.Cons $+      case xt of+         Nil -> (y, xt)+         Cons x xs ->+            case f y x of+               GT -> (x, fromNonEmpty $ NonEmpty.insertBy f y xs)+               _ -> (y, xt)++instance NonEmpty.RemoveEach f => NonEmpty.RemoveEach (T f) where+   removeEach (NonEmpty.Cons x Nil) = NonEmpty.Cons (x, Nil) Nil+   removeEach (NonEmpty.Cons x0 xs0@(Cons x1 xs1)) =+      NonEmpty.Cons (x0, xs0) $+      fmap (mapSnd (x0 ?:)) $+      fromNonEmpty $ NonEmpty.removeEach $ NonEmpty.Cons x1 xs1++instance NonEmpty.Tails f => NonEmpty.Tails (T f) where+   tails xt =+      NonEmpty.force $+      case xt of+         Nil -> NonEmpty.Cons C.empty Nil+         Cons x xs ->+            case NonEmpty.tails xs of+               xss -> NonEmpty.Cons (C.cons x $ NonEmpty.head xss) (fromNonEmpty xss)