OneTuple 0.3.1 → 0.4

raw patch · 7 files changed

+114/−48 lines, 7 filesdep +foldable1-classes-compatdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: foldable1-classes-compat

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Changelog.md +6/−0
• OneTuple.cabal +17/−9
• src/Data/Tuple/OneTuple.hs +5/−1
• src/Data/Tuple/Solo.hs +80/−34
• src/Data/Tuple/Solo/TH.hs +1/−1
• test/instances.hs +4/−2
• test/th.hs +1/−1

@@ -1,3 +1,9 @@+# 0.4++- Rename constructor to `MkSolo` as in `base-4.17`.+  The compatibility pattern synonym is provided.+- Add `Foldable1 Solo` instance+ # 0.3.1  - Add `Data.Tuple.Solo.TH` with `tupE` using `Solo` from this package

@@ -1,12 +1,12 @@-cabal-version:      >=1.10+cabal-version:      1.12 name:               OneTuple-version:            0.3.1+version:            0.4 synopsis:           Singleton Tuple category:           Data description:   This package is a compatibility package for a singleton data type   .-  > data Solo a = Solo a+  > data Solo a = MkSolo a   .   Note: it's not a @newtype@   .@@ -31,9 +31,11 @@    || ==8.4.4    || ==8.6.5    || ==8.8.4-   || ==8.10.4-   || ==9.0.1-   || ==9.2.1+   || ==8.10.7+   || ==9.0.2+   || ==9.2.5+   || ==9.4.4+   || ==9.6.1  extra-source-files: Changelog.md @@ -50,7 +52,7 @@    hs-source-dirs:   src   build-depends:-      base              >=4.5 && <4.17+      base              >=4.5 && <4.19     , template-haskell    if impl(ghc >=9.0)@@ -61,7 +63,7 @@    if !impl(ghc >=8.0)     build-depends:-        semigroups    >=0.18.4 && <0.20+        semigroups    >=0.18.4 && <0.21       , transformers  >=0.3    && <0.7      -- Ensure Data.Functor.Classes is always available@@ -69,7 +71,7 @@       build-depends: transformers >=0.4.2.0      else-      build-depends: transformers-compat >=0.5.1.0 && <0.7+      build-depends: transformers-compat >=0.5.1.0 && <0.8    if !impl(ghc >=9.2)     build-depends: base-orphans >=0.8.6@@ -77,6 +79,9 @@   if !impl(ghc >=7.6)     build-depends: ghc-prim +  if !impl(ghc >=9.0)+     build-depends: foldable1-classes-compat >=0.1 && <0.2+ test-suite instances   type:             exitcode-stdio-1.0   default-language: Haskell98@@ -92,6 +97,9 @@         semigroups       , transformers       , transformers-compat++  if !impl(ghc >=9.6)+     build-depends: foldable1-classes-compat >=0.1 && <0.2  test-suite th   type:             exitcode-stdio-1.0

@@ -27,5 +27,9 @@ #if __GLASGOW_HASKELL__ >= 710 pattern OneTuple :: a -> Solo a #endif-pattern OneTuple a = Solo a+pattern OneTuple a = MkSolo a+#endif++#if __GLASGOW_HASKELL__ >= 800+{-# COMPLETE OneTuple #-} #endif

@@ -3,6 +3,10 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE DeriveGeneric #-} +#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE PatternSynonyms #-}+#endif+ -- | 'Solo' fills the /tuple gap/ with a singleton tuple. -- -- 'Solo' /does not support/ the usual parenthesized tuple syntax.@@ -21,7 +25,14 @@ -- Note: on GHC-9.0 'getSolo' is not a record selector.  module Data.Tuple.Solo (-    Solo(Solo),+#if __GLASGOW_HASKELL__ >= 800+    Solo(MkSolo,Solo),+#elif __GLASGOW_HASKELL__ >= 708+    Solo(MkSolo),+    pattern Solo,+#else+    Solo(MkSolo),+#endif     getSolo, ) where @@ -29,9 +40,16 @@ import Data.Orphans () #endif -#if MIN_VERSION_base(4,16,0)+#if MIN_VERSION_base(4,18,0)+import GHC.Tuple (Solo (MkSolo, Solo), getSolo)+++#elif MIN_VERSION_base(4,16,0) import GHC.Tuple (Solo (Solo), getSolo) +pattern MkSolo :: a -> Solo a+pattern MkSolo a = Solo a+ #elif MIN_VERSION_base(4,15,0) import GHC.Tuple (Solo (Solo)) @@ -39,6 +57,11 @@ getSolo :: Solo a -> a getSolo (Solo x) = x +pattern MkSolo :: a -> Solo a+pattern MkSolo a = Solo a++{-# COMPLETE MkSolo #-}+ #else  #if MIN_VERSION_base(4,9,0)@@ -61,11 +84,14 @@ import Data.Data           (Data) import Data.Foldable       (Foldable (..)) import Data.Ix             (Ix (..))+import Data.List.NonEmpty  (NonEmpty (..)) import Data.Monoid         (Monoid (..)) import Data.Semigroup      (Semigroup (..)) import Data.Traversable    (Traversable (..)) import Data.Typeable       (Typeable) +import qualified Data.Foldable1 as F1+ import Data.Functor.Classes (Eq1 (..), Ord1 (..), Show1 (..), Read1 (..))  #if !(MIN_VERSION_base(4,15,0))@@ -85,7 +111,7 @@ import Control.Monad.Zip   (MonadZip (..))  -- | Solo is the singleton tuple data type.-data Solo a = Solo { getSolo :: a }+data Solo a = MkSolo { getSolo :: a }   deriving     ( Eq,Ord,Bounded,Read,Typeable,Data     , Generic@@ -94,28 +120,40 @@ #endif     ) +#if __GLASGOW_HASKELL__ >= 708+#if __GLASGOW_HASKELL__ >= 710+pattern Solo :: a -> Solo a+#endif+pattern Solo a = MkSolo a+#endif++#if __GLASGOW_HASKELL__ >= 800+{-# COMPLETE Solo #-}+#endif++ instance Show a => Show (Solo a) where-  showsPrec d (Solo x) = showParen (d > 10) $-      showString "Solo " . showsPrec 11 x+  showsPrec d (MkSolo x) = showParen (d > 10) $+      showString "MkSolo " . showsPrec 11 x  instance (Enum a) => Enum (Solo a) where     succ = fmap succ     pred = fmap pred     toEnum = pure . toEnum-    fromEnum (Solo x) = fromEnum x+    fromEnum (MkSolo x) = fromEnum x  instance (Ix a) => Ix (Solo a) where-    range   (Solo x, Solo y) = map Solo (range (x,y))-    index   (Solo x, Solo y) (Solo z) = index   (x,y) z-    inRange (Solo x, Solo y) (Solo z) = inRange (x,y) z+    range   (MkSolo x, MkSolo y) = map MkSolo (range (x,y))+    index   (MkSolo x, MkSolo y) (MkSolo z) = index   (x,y) z+    inRange (MkSolo x, MkSolo y) (MkSolo z) = inRange (x,y) z  instance Foldable Solo where-    fold (Solo m) = m-    foldMap f (Solo x) = f x-    foldr f b (Solo x) = f x b-    foldl f a (Solo x) = f a x-    foldr1 _f (Solo x) = x-    foldl1 _f (Solo x) = x+    fold (MkSolo m) = m+    foldMap f (MkSolo x) = f x+    foldr f b (MkSolo x) = f x b+    foldl f a (MkSolo x) = f a x+    foldr1 _f (MkSolo x) = x+    foldl1 _f (MkSolo x) = x      -- TODO: add rest of the methods #if MIN_VERSION_base(4,8,0)@@ -127,21 +165,29 @@     sum     = getSolo     product = getSolo -    toList (Solo a) = [a]+    toList (MkSolo a) = [a] #endif -instance Traversable Solo where-    traverse f (Solo x) = fmap Solo (f x)-    sequenceA (Solo x) = fmap Solo x+-- | @since 0.4+instance F1.Foldable1 Solo where+    foldMap1 f (MkSolo y) = f y+    toNonEmpty (MkSolo x) = x :| []+    minimum (MkSolo x) = x+    maximum (MkSolo x) = x+    head (MkSolo x) = x+    last (MkSolo x) = x +instance Traversable Solo where+    traverse f (MkSolo x) = fmap MkSolo (f x)+    sequenceA (MkSolo x) = fmap MkSolo x  instance Functor Solo where-    fmap f (Solo x) = Solo (f x)+    fmap f (MkSolo x) = MkSolo (f x)  instance Applicative Solo where-    pure = Solo+    pure = MkSolo -    Solo f <*> Solo x = Solo (f x)+    MkSolo f <*> MkSolo x = MkSolo (f x)     _ *> x = x     x <* _ = x @@ -152,41 +198,41 @@ instance Monad Solo where     return = pure     (>>) = (*>)-    Solo x >>= f = f x+    MkSolo x >>= f = f x  instance Semigroup a => Semigroup (Solo a) where-    Solo x <> Solo y = Solo (x <> y)+    MkSolo x <> MkSolo y = MkSolo (x <> y)  instance Monoid a => Monoid (Solo a) where-    mempty = Solo mempty-    mappend (Solo x) (Solo y) = Solo (mappend x y)+    mempty = MkSolo mempty+    mappend (MkSolo x) (MkSolo y) = MkSolo (mappend x y)  instance MonadFix Solo where     mfix f = let a = f (getSolo a) in a  instance MonadZip Solo where-    mzipWith f (Solo a) (Solo b) = Solo (f a b)+    mzipWith f (MkSolo a) (MkSolo b) = MkSolo (f a b)  #ifdef LIFTED_FUNCTOR_CLASSES instance Eq1 Solo where-  liftEq eq (Solo a) (Solo b) = a `eq` b+  liftEq eq (MkSolo a) (MkSolo b) = a `eq` b  instance Ord1 Solo where-  liftCompare cmp (Solo a) (Solo b) = cmp a b+  liftCompare cmp (MkSolo a) (MkSolo b) = cmp a b  instance Read1 Solo where #if MIN_VERSION_base(4,10,0)-    liftReadPrec rp _ = readData (readUnaryWith rp "Solo" Solo)+    liftReadPrec rp _ = readData (readUnaryWith rp "MkSolo" MkSolo)      liftReadListPrec = liftReadListPrecDefault     liftReadList     = liftReadListDefault #else-    liftReadsPrec rp _ = readsData $ readsUnaryWith rp "Solo" Solo+    liftReadsPrec rp _ = readsData $ readsUnaryWith rp "MkSolo" MkSolo #endif  instance Show1 Solo where-    liftShowsPrec sp _ d (Solo x) = showParen (d > 10) $-      showString "Solo " . sp 11 x+    liftShowsPrec sp _ d (MkSolo x) = showParen (d > 10) $+      showString "MkSolo " . sp 11 x  #else instance Eq1 Solo where eq1 = (==)@@ -204,5 +250,5 @@  -- | @since 0.3.1 instance Hashable1 Solo where-    liftHashWithSalt h salt (Solo a) = h salt a+    liftHashWithSalt h salt (MkSolo a) = h salt a #endif

@@ -33,7 +33,7 @@ #error "CURRENT_PACKAGE_KEY undefined" #endif -soloConName = TH.mkNameG_d CURRENT_PACKAGE_KEY "Data.Tuple.Solo" "Solo"+soloConName = TH.mkNameG_d CURRENT_PACKAGE_KEY "Data.Tuple.Solo" "MkSolo" #endif  tupE :: Monad m => [m TH.Exp] -> m TH.Exp

@@ -5,6 +5,7 @@ import Control.Monad.Fix    (MonadFix (..)) import Data.Data            (Data) import Data.Foldable        (Foldable (..))+import Data.Foldable1       (Foldable1) import Data.Functor.Classes (Eq1, Ord1, Read1, Show1) import Data.Hashable        (Hashable) import Data.Hashable.Lifted (Hashable1)@@ -27,10 +28,10 @@ -------------------------------------------------------------------------------  tup1 :: Solo Char-tup1 = Solo 'x'+tup1 = MkSolo 'x'  tup2 :: Solo String-tup2 = Solo "test"+tup2 = MkSolo "test"  hasEq :: Eq a => a -> a; hasEq x = x; testEq = hasEq tup1 hasOrd :: Ord a => a -> a; hasOrd x = x; testOrd = hasOrd tup1@@ -47,6 +48,7 @@  hasFunctor :: Functor f => f a -> f a; hasFunctor x = x; testFunctor = hasFunctor tup1 hasFoldable :: Foldable f => f a -> f a; hasFoldable x = x; testFoldable = hasFoldable tup1+hasFoldable1 :: Foldable1 f => f a -> f a; hasFoldable1 x = x; testFoldable1 = hasFoldable1 tup1 hasTraversable :: Traversable f => f a -> f a; hasTraversable x = x; testTraversable = hasTraversable tup1 hasApplicative :: Applicative f => f a -> f a; hasApplicative x = x; testApplicative = hasApplicative tup1 hasMonad :: Monad f => f a -> f a; hasMonad x = x; testMonad = hasMonad tup1

@@ -5,4 +5,4 @@ import Data.Tuple.Solo.TH (tupE)  main :: IO ()-main = print $ Solo 'x' == $(tupE [[| 'x' |]])+main = print $ MkSolo 'x' == $(tupE [[| 'x' |]])