nonempty-lift (empty) → 0.1
raw patch · 6 files changed
+298/−0 lines, 6 filesdep +basedep +comonaddep +hedgehog
Dependencies added: base, comonad, hedgehog, hedgehog-classes, nonempty-lift, semigroupoids
Files
- CHANGELOG.md +12/−0
- LICENSE +21/−0
- README.md +7/−0
- nonempty-lift.cabal +68/−0
- src/NonEmpty.hs +149/−0
- test/Laws.hs +41/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++`non` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++0.1+===++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/chessai/non-empty-applicative/releases
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 chessai++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,7 @@+# non-empty-applicative++[](https://hackage.haskell.org/package/non-empty-applicative)+[](LICENSE)+[](https://travis-ci.org/chessai/non-empty-applicative)++non-empty applicative structure
+ nonempty-lift.cabal view
@@ -0,0 +1,68 @@+cabal-version: 2.2+name:+ nonempty-lift+version:+ 0.1+synopsis:+ nonempty structure+description:+ nonempty structure, parameterised by another structure+homepage:+ https://github.com/chessai/nonempty+bug-reports:+ https://github.com/chessai/nonempty/issues+license:+ BSD-3-Clause+license-file:+ LICENSE+author:+ chessai+maintainer:+ chessai <chessai1996@gmail.com>+copyright:+ © 2019 chessai+category:+ Data+build-type:+ Simple+extra-doc-files:+ README.md+ , CHANGELOG.md+tested-with:+ GHC == 8.6.5++library+ hs-source-dirs:+ src+ exposed-modules:+ NonEmpty+ build-depends:+ , base >= 4.12 && < 4.13+ , comonad >= 5 && < 5.1+ , semigroupoids >= 5.3 && < 5.4+ ghc-options:+ -Wall+ -O2+ default-language:+ Haskell2010++test-suite laws+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is:+ Laws.hs+ build-depends:+ , base+ , hedgehog+ , hedgehog-classes >= 0.2.3 && < 0.3+ , nonempty-lift+ default-language:+ Haskell2010++source-repository head+ type:+ git+ location:+ https://github.com/chessai/nonempty.git
+ src/NonEmpty.hs view
@@ -0,0 +1,149 @@+{-# language+ DeriveAnyClass+ , DeriveFoldable+ , DeriveFunctor+ , DeriveGeneric+ , DeriveTraversable+ , DerivingStrategies+ #-}++{-| This module provides a way to lift potentially empty structures+ into one which is guaranteed to be NonEmpty by construction.+-}++module NonEmpty+ ( NonEmpty(..)++ , head+ , tail+ , toList+ , zip+ , zipWith+ , unzip+ , nonEmpty+ ) where++import Control.Comonad+import Control.Comonad.Hoist.Class+import Control.Monad.Zip+import Data.Foldable hiding (toList)+import Data.Functor.Apply+import Data.Semigroup.Foldable.Class+import GHC.Generics (Generic, Generic1)+import Prelude hiding (head, tail,zip,zipWith,unzip)+import qualified Data.Foldable as F+import qualified Data.List.NonEmpty as NE++-- | A structure which is nonempty by construction.+--+-- Typically this will be used to construct list-like structures; e.g.+--+-- * @NonEmpty [] a@ is a lazy list containing at least one element.+--+-- * @NonEmpty (NonEmpty []) a@ is a lazy list containing at least two+-- elements.+--+-- * @NonEmpty Maybe a@ is a list that contains one or two elements.+data NonEmpty f a = NonEmpty a (f a)+ deriving stock (Functor, Foldable, Traversable)+ deriving stock (Generic, Generic1)+ deriving stock (Show, Read)+ deriving stock (Eq, Ord)+ deriving anyclass (ComonadApply)++instance Applicative f => Applicative (NonEmpty f) where+ pure x = NonEmpty x (pure x)+ (<*>) = apNonEmpty (<*>)++instance Apply f => Apply (NonEmpty f) where+ (<.>) = apNonEmpty (<.>)++apNonEmpty :: ()+ => (f (a -> b) -> f a -> f b)+ -> NonEmpty f (a -> b)+ -> NonEmpty f a+ -> NonEmpty f b+apNonEmpty ap (NonEmpty f fs) (NonEmpty x xs) = NonEmpty (f x) (ap fs xs)+{-# inline apNonEmpty #-}++instance (Applicative f, Comonad f) => Comonad (NonEmpty f) where+ extract = head+ duplicate w@(NonEmpty _ f) = NonEmpty w (fmap pure f)++instance ComonadHoist NonEmpty where+ cohoist f (NonEmpty x w) = NonEmpty x (f w)++-- i don't understand trace comonads yet, so i won't include this.+--instance (Monoid m, ComonadTraced m w) => ComonadTraced m (NonEmpty w) where++-- Is this lawful? What are the laws of ComonadTrans?+-- Is it just dual to MonadTrans, i.e. 'lower' must be+-- a Comonad homomorphism?+--instance ComonadTrans NonEmpty where+-- lower = tail++instance (Foldable f) => Foldable1 (NonEmpty f) where+ fold1 (NonEmpty a f) = fold' a f+ {-# inline fold1 #-}+ foldMap1 h (NonEmpty a f) = foldMap' a h f+ {-# inline foldMap1 #-}+ toNonEmpty (NonEmpty a f) = toNonEmpty' a f+ {-# inline toNonEmpty #-}++-- | Get the head of a 'NonEmpty'.+head :: NonEmpty f a -> a+head ~(NonEmpty a _) = a+{-# inline head #-}++-- | Get the 'tail' of a 'NonEmpty'.+tail :: NonEmpty f a -> f a+tail ~(NonEmpty _ f) = f+{-# inline tail #-}++-- | Convert a 'NonEmpty' into a list.+toList :: Foldable f => NonEmpty f a -> [a]+toList ~(NonEmpty a f) = a : F.toList f+{-# inline toList #-}++-- | Zip two 'NonEmpty's together.+zip :: (MonadZip f)+ => NonEmpty f a+ -> NonEmpty f b+ -> NonEmpty f (a,b)+zip = zipWith (,)+{-# inline zip #-}++-- | Zip two 'NonEmpty's together with a combining function.+zipWith :: (MonadZip f)+ => (a -> b -> c)+ -> NonEmpty f a+ -> NonEmpty f b+ -> NonEmpty f c+zipWith f ~(NonEmpty a fa) ~(NonEmpty b fb)+ = NonEmpty (f a b) (mzipWith f fa fb)+{-# inline zipWith #-}++-- | Unzip a 'NonEmpty'.+unzip :: (Functor f)+ => NonEmpty f (a,b)+ -> (NonEmpty f a, NonEmpty f b)+unzip = NE.unzip+{-# inline unzip #-}++-- | Construct a 'NonEmpty'.+nonEmpty :: a -> f a -> NonEmpty f a+nonEmpty = NonEmpty+{-# inline nonEmpty #-}++-- Internal --+toNonEmpty' :: (Foldable t) => a -> t a -> NE.NonEmpty a+toNonEmpty' a xs = a NE.:| F.toList xs+{-# inline toNonEmpty' #-}++foldMap' :: (Semigroup m, Foldable t) => a -> (a -> m) -> t a -> m+foldMap' z0 f = foldr ((<>) . f) (f z0)+{-# inline foldMap' #-}++fold' :: (Semigroup m, Foldable t) => m -> t m -> m+fold' z0 = foldMap' z0 id+{-# inline fold' #-}
+ test/Laws.hs view
@@ -0,0 +1,41 @@+module Main (main) where++import Control.Applicative (liftA2)+import Hedgehog+import Hedgehog.Classes+import NonEmpty+import qualified Data.List.NonEmpty as Base+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++main :: IO Bool+main = lawsCheckMany+ [ ( "NonEmpty f"+ , [ functorLaws genNonEmpty1+ , foldableLaws genNonEmpty1+ , applicativeLaws genNonEmpty1+ , traversableLaws genNonEmpty1+ , comonadLaws genNonEmpty1+ ]+ )+ , ( "NonEmpty f a"+ , [ showLaws genNonEmpty+ , showReadLaws genNonEmpty+ , eqLaws genNonEmpty+ , ordLaws genNonEmpty+ -- , genericLaws genNonEmpty+ ]+ )+ ]++genNonEmpty :: Gen (NonEmpty Base.NonEmpty [Integer])+genNonEmpty = genNonEmpty1 (Gen.list (Range.linear 0 6) genInteger)++genInteger :: Gen Integer+genInteger = Gen.integral_ (Range.linear (-1000) 1000)++genNonEmpty1 :: Gen a -> Gen (NonEmpty Base.NonEmpty a)+genNonEmpty1 gen = do+ a <- gen+ as <- liftA2 (Base.:|) gen (Gen.list (Range.linear 0 6) gen)+ pure (NonEmpty a as)