packages feed

nonempty-wrapper (empty) → 0.1.0.0

raw patch · 5 files changed

+281/−0 lines, 5 filesdep +basedep +hspecdep +hspec-core

Dependencies added: base, hspec, hspec-core, hspec-discover, nonempty-wrapper

Files

+ LICENSE view
@@ -0,0 +1,15 @@+ISC License++Copyright (c) 2022 Gautier DI FOLCO++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY+AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.
+ nonempty-wrapper.cabal view
@@ -0,0 +1,86 @@+cabal-version:       3.0+name:                nonempty-wrapper+version:             0.1.0.0+author:              Gautier DI FOLCO+maintainer:          gautier.difolco@gmail.com+category:            Data+build-type:          Simple+license:             ISC+license-file:        LICENSE+synopsis:            Create NonEmpty version of any container+description:         Create NonEmpty version of any container.+Homepage:            http://github.com/blackheaven/nonempty-wrapper/nonempty-wrapper+tested-with:         GHC==9.2.2, GHC==9.0.2, GHC==8.10.7++library+  default-language:   Haskell2010+  build-depends:+        base == 4.*+  hs-source-dirs: src+  exposed-modules:+      Data.NonEmpty+  other-modules:+      Paths_nonempty_wrapper+  autogen-modules:+      Paths_nonempty_wrapper+  default-extensions:+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveGeneric+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      FlexibleContexts+      GADTs+      GeneralizedNewtypeDeriving+      KindSignatures+      LambdaCase+      OverloadedLists+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      TypeApplications+      TypeFamilies+      TypeOperators+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints++test-suite nonempty-wrapper-test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules:+      Data.NonEmptySpec+      Paths_nonempty_wrapper+  autogen-modules:+      Paths_nonempty_wrapper+  default-extensions:+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveGeneric+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      FlexibleContexts+      GADTs+      GeneralizedNewtypeDeriving+      KindSignatures+      LambdaCase+      OverloadedLists+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      TypeApplications+      TypeFamilies+      TypeOperators+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+  build-depends:+      base+    , nonempty-wrapper+    , hspec+    , hspec-core+    , hspec-discover+  default-language: Haskell2010
+ src/Data/NonEmpty.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE FlexibleInstances #-}++-- |+-- Module        : Data.NonEmpty+-- Copyright     : Gautier DI FOLCO+-- License       : BSD2+--+-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>+-- Stability     : Unstable+-- Portability   : GHC+--+-- Create NonEmpty version of any container.+module Data.NonEmpty+  ( -- * Base type+    NonEmpty,+    getNonEmpty,+    trustedNonEmpty,++    -- * Singleton constructor+    NonEmptySingleton (..),+    singleton,+    MkNonEmptySingletonApplicative (..),++    -- * From container+    NonEmptyFromContainer (..),+    nonEmpty,+    MkNonEmptyFromContainerFoldable (..),++    -- * Operations+    (<|),+    (|>),+    overNonEmpty,+    overNonEmpty2,+    overNonEmpty3,+    overNonEmpty4,+    overNonEmpty5,+    fmapNonEmpty,+    withNonEmpty,+  )+where++import Data.Maybe(fromJust)+import Data.Kind+import Data.Proxy++-- | NonEmpty proofed value.+newtype NonEmpty a = NonEmpty+  { -- | Extract the NonEmpty proven value+    getNonEmpty :: a+  }+  deriving stock (Eq, Ord, Show)++instance Semigroup a => Semigroup (NonEmpty a) where+  NonEmpty x <> NonEmpty y = NonEmpty $ x <> y++-- * Operations++-- | Append empty container+(<|) :: Semigroup a => NonEmpty a -> a -> NonEmpty a+NonEmpty ne <| n = NonEmpty $ ne <> n+{-# INLINE (<|) #-}++infixr 6 <|++-- | Prepend empty container+(|>) :: Semigroup a => a -> NonEmpty a -> NonEmpty a+n |> NonEmpty ne = NonEmpty $ n <> ne+{-# INLINE (|>) #-}++infixr 6 |>++-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)+overNonEmpty :: (a -> b) -> NonEmpty a -> NonEmpty b+overNonEmpty f = trustedNonEmpty . f . getNonEmpty+{-# INLINE overNonEmpty #-}++-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)+overNonEmpty2 :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c+overNonEmpty2 f a = trustedNonEmpty . f (getNonEmpty a) . getNonEmpty+{-# INLINE overNonEmpty2 #-}++-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)+overNonEmpty3 :: (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d+overNonEmpty3 f a b = trustedNonEmpty . f (getNonEmpty a) (getNonEmpty b) . getNonEmpty+{-# INLINE overNonEmpty3 #-}++-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)+overNonEmpty4 :: (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e+overNonEmpty4 f a b c = trustedNonEmpty . f (getNonEmpty a) (getNonEmpty b) (getNonEmpty c) . getNonEmpty+{-# INLINE overNonEmpty4 #-}++-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)+overNonEmpty5 :: (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f+overNonEmpty5 f a b c d = trustedNonEmpty . f (getNonEmpty a) (getNonEmpty b) (getNonEmpty c) (getNonEmpty d) . getNonEmpty+{-# INLINE overNonEmpty5 #-}++-- | 'fmap' over a 'NonEmpty' container+fmapNonEmpty :: Functor f => (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)+fmapNonEmpty f = overNonEmpty (fmap f)+{-# INLINE fmapNonEmpty #-}++-- | Apply an unsafe function over empty, which is safe over 'NonEmpty'+withNonEmpty :: (a -> Maybe b) -> NonEmpty a -> b+withNonEmpty f = fromJust . f . getNonEmpty+{-# INLINE withNonEmpty #-}++-- | Trusted value+trustedNonEmpty :: a -> NonEmpty a+trustedNonEmpty = NonEmpty+{-# INLINE trustedNonEmpty #-}++-- | Singleton constructible value+class NonEmptySingleton a where+  type NonEmptySingletonElement a :: Type+  nonEmptySingleton :: Proxy a -> NonEmptySingletonElement a -> a++-- | Build a 'NonEmpty' value from a singleton value+singleton :: NonEmptySingleton a => Proxy a -> NonEmptySingletonElement a -> NonEmpty a+singleton p = trustedNonEmpty . nonEmptySingleton p+{-# INLINE singleton #-}++-- | Build 'NonEmptySingleton' for 'Applicative' defined types+--   to be used with 'DerivingVia':+--+--   > deriving instance NonEmptySingleton [a] via (MkNonEmptySingletonApplicative [a])+newtype MkNonEmptySingletonApplicative a+  = MkNonEmptySingletonApplicative a++instance Applicative f => NonEmptySingleton (f a) where+  type NonEmptySingletonElement (f a) = a+  nonEmptySingleton _ = pure++-- * From container++-- | Used to attempt conversion from possibly empty to 'NonEmpty'.+class NonEmptyFromContainer a where+  isNonEmpty :: a -> Bool++-- | Attempt 'NonEmpty' proof+nonEmpty :: NonEmptyFromContainer a => a -> Maybe (NonEmpty a)+nonEmpty x =+  if isNonEmpty x+    then Just $ trustedNonEmpty x+    else Nothing++-- | Build 'MkNonEmptyFromContainerFoldable' for 'Foldable' defined types+--   to be used with 'DerivingVia':+--+--   > deriving instance NonEmptyFromContainer [a] via (MkNonEmptyFromContainerFoldable [a])+newtype MkNonEmptyFromContainerFoldable a+  = MkNonEmptyFromContainerFoldable a++instance Foldable f => NonEmptyFromContainer (f a) where+  isNonEmpty = not . null
+ test/Data/NonEmptySpec.hs view
@@ -0,0 +1,25 @@+module Data.NonEmptySpec+  ( main,+    spec,+  )+where++import Data.NonEmpty+import Data.Proxy+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  it "Singleton creation should be equivalent to a single element list" $+    singleton (Proxy @[Int]) 42 `shouldBe` trustedNonEmpty [42]+  it "nonEmpty creation on filled list should be equivalent to the wrapped list" $+    nonEmpty @[Int] [1, 2, 3] `shouldBe` Just (trustedNonEmpty [1, 2, 3])+  it "nonEmpty creation on empty list should be Nothing" $+    nonEmpty @[Int] [] `shouldBe` Nothing+  it "prepend should use semigroup" $+    singleton (Proxy @[Int]) 1 <| [2] `shouldBe` trustedNonEmpty [1, 2]+  it "append should use semigroup" $+    [1] |> singleton (Proxy @[Int]) 2 `shouldBe` trustedNonEmpty [1, 2]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}