nonempty-alternative (empty) → 0.3.0

raw patch · 4 files changed

+220/−0 lines, 4 filesdep +basedep +comonaddep +semigroupssetup-changed

Dependencies added: base, comonad, semigroups

Files

LICENSE +30/−0
Setup.hs +2/−0
nonempty-alternative.cabal +25/−0
src/Data/NonEmpty.hs +163/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright guaraqe (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of guaraqe nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ nonempty-alternative.cabal view

@@ -0,0 +1,25 @@+name:                nonempty-alternative+version:             0.3.0+synopsis:            NonEmpty for Alternative types+description:         Please see README.md+homepage:            http://github.com/guaraqe/nonempty-alternative#readme+license:             BSD3+license-file:        LICENSE+author:              guaraqe+maintainer:          guaraqe@openmailbox.org+copyright:           2016 guaraqe+category:            Data+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.NonEmpty+  build-depends:       base >= 4.7 && < 5+                     , semigroups >= 0.18+                     , comonad >= 4.2+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/guaraqe/nonempty-alternative

+ src/Data/NonEmpty.hs view

@@ -0,0 +1,163 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++module Data.NonEmpty+       (+       -- * The type of left non-empty alternatives+         NonEmptyL (..)+       -- * Basic functions for `NonEmptyL`+       , headL+       , tailL+       , flattenL+       , joinL+       , budgeL+       -- * The type of right non-empty alternatives+       , NonEmptyR (..)+       -- * Basic functions for `NonEmptyR`+       , lastR+       , initR+       , flattenR+       , joinR+       , budgeR+       ) where++import Prelude hiding (head, tail)+import Data.Data+import GHC.Generics++import Data.Foldable+import Data.Semigroup+import Control.Applicative+import Control.Comonad++----------------------------------------------------------------------++-- | NonEmptyL is naturally extended from `List` to any `Alternative`+-- type in two different ways. They are differentiated by their+-- instances.+-- The `L`eft one is well suited for `cons` structures.+data NonEmptyL f a = a :< f a+  deriving (Show, Eq, Ord,Read, Data, Typeable, Generic, Generic1)++infixr 5 :<++-- | The `R`ight one is well suited for `snoc` structures.+data NonEmptyR f a = f a :> a+  deriving (Show, Eq, Ord,Read, Data, Typeable, Generic, Generic1)++infixl 5 :>++----------------------------------------------------------------------++instance Functor f => Functor (NonEmptyL f) where+  fmap f (x :< xs) = (f x) :< (f <$> xs)++instance Functor f => Functor (NonEmptyR f) where+  fmap f (xs :> x) = (f <$> xs) :> (f x)++----------------------------------------------------------------------++instance Alternative f => Applicative (NonEmptyL f) where+  pure x = x :< empty++  (f :< fs) <*> (x :< xs) = (f x) :< (   (pure f <*> xs    )+                                     <|> (fs     <*> (pure x <|> xs)))++instance Alternative f => Applicative (NonEmptyR f) where+  pure x = empty :> x++  (fs :> f) <*> (xs :> x) = (   (fs     <*> (xs <|> pure x) )+                            <|> (pure f <*> xs    ) ) :> (f x)++----------------------------------------------------------------------++instance (Alternative f, Monad f) => Monad (NonEmptyL f) where+  (x :< xs) >>= f = y :< (ys <|> zs)+                  where (y :< ys) = f x+                        zs = xs >>= flattenL . f++----------------------------------------------------------------------++instance Alternative f => Comonad (NonEmptyL f) where+  extract = headL+  duplicate (x :< xs) = (x :< xs) :< (fmap (:< empty) xs)++instance Alternative f => Comonad (NonEmptyR f) where+  extract = lastR+  duplicate (xs :> x) = (fmap (empty :>) xs) :> (xs :> x)++----------------------------------------------------------------------++instance Foldable f => Foldable (NonEmptyL f) where+  foldr f z (x :< xs) = f x (foldr f z xs)+  foldr' f z (x :< xs) = f x (foldr' f z xs)+  foldr1 f (x :< xs) = if null xs+                          then x+                          else f x (foldr1 f xs)+  foldl f z (x :< xs) = foldl f (f z x) xs+  foldl' f z (x :< xs) = foldl' f (f z x) xs+  foldl1 f (x :< xs) = foldl f x xs++instance Foldable f => Foldable (NonEmptyR f) where+  foldr f z (xs :> x) = foldr f (f x z) xs+  foldr' f z (xs :> x) = foldr' f (f x z) xs+  foldr1 f (xs :> x) = foldr f x xs+  foldl f z (xs :> x) = f (foldl f z xs) x+  foldl' f z (xs :> x) = f (foldl' f z xs) x+  foldl1 f (xs :> x) = if null xs+                          then x+                          else f (foldl1 f xs) x++----------------------------------------------------------------------++instance (Functor f, Traversable f) => Traversable (NonEmptyL f) where+  traverse f (x :< xs) = (:<) <$> f x+                              <*> traverse f xs++instance (Functor f, Traversable f) => Traversable (NonEmptyR f) where+  traverse f (xs :> x) = (:>) <$> traverse f xs+                              <*> f x++----------------------------------------------------------------------++instance Alternative f => Semigroup (NonEmptyL f a) where+  (x :< xs) <> (y :< ys) = x :< (xs <|> pure y <|> ys)++instance Alternative f => Semigroup (NonEmptyR f a) where+  (xs :> x) <> (ys :> y) = (xs <|> pure x <|> ys) :> y++----------------------------------------------------------------------++headL :: NonEmptyL f a -> a+headL (x :< _) = x++tailL :: NonEmptyL f a -> f a+tailL (_ :< xs) = xs++flattenL :: Alternative f => NonEmptyL f a -> f a+flattenL (x :< xs) = pure x <|> xs++joinL :: (Alternative f, Monad f)+      => NonEmptyL f (NonEmptyL f a) -> NonEmptyL f a+joinL ((x :< xs) :< ys) = x :< (xs <|> (ys >>= flattenL))++budgeL :: (Alternative f, Alternative g)+       => NonEmptyL f (g a) -> NonEmptyL f (g a)+budgeL = (empty :<) . flattenL++lastR :: NonEmptyR f a -> a+lastR (_ :> x) = x++initR :: NonEmptyR f a -> f a+initR (xs :> _) = xs++flattenR :: Alternative f => NonEmptyR f a -> f a+flattenR (xs :> x) = xs <|> pure x++joinR :: (Alternative f, Monad f)+      => NonEmptyR f (NonEmptyR f a) -> NonEmptyR f a+joinR (ys :> (xs :> x)) = ((ys >>= flattenR) <|> xs) :> x++budgeR :: (Alternative f, Alternative g)+       => NonEmptyR f (g a) -> NonEmptyR f (g a)+budgeR = (:> empty) . flattenR