smash 0.1.3 → 0.2.0

raw patch · 12 files changed

+185/−28 lines, 12 filesdep +QuickCheckdep +smashdep +tastydep ~basedep ~bifunctorsdep ~binaryPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, smash, tasty, tasty-hunit, tasty-quickcheck, transformers

Dependency ranges changed: base, bifunctors, binary, deepseq, hashable, mtl, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• LICENSE +1/−1
• README.md +1/−1
• smash.cabal +34/−12
• src/Control/Monad/Trans/Can.hs +6/−2
• src/Control/Monad/Trans/Smash.hs +4/−1
• src/Control/Monad/Trans/Wedge.hs +7/−3
• src/Data/Can.hs +7/−3
• src/Data/Smash.hs +2/−2
• src/Data/Smash/Internal.hs +1/−1
• src/Data/Wedge.hs +2/−2
• test/Main.hs +108/−0

@@ -1,5 +1,17 @@ # Revision history for smash +## 0.2.0 -- 2026-10-26++* Start the `0.2` major release series with the 2026 compiler support and test suite.+* Preserve the existing public API and binary representations.++## 0.1.4 -- 2026-10-26++* Update dependency bounds and the supported GHC matrix to 9.6–9.14.+* Update copyrights through 2026.+* Expose `Data.Smash.Internal` alongside the other library modules.+* Add Tasty unit and property tests for data types, instances, and transformers.+ ## 0.1.3 -- 2022-04-03  * Update `base` bounds to allow GHC 9.2.x

@@ -1,4 +1,4 @@-Copyright (c) 2020, Emily Pillmore+Copyright (c) 2020-2026, Emily Pillmore  All rights reserved. 

@@ -1,6 +1,6 @@ # smash: Combinators for Maybe types -[![Build Status](https://travis-ci.com/emilypi/smash.svg?branch=master)](https://travis-ci.com/emilypi/smash)+[![CI](https://github.com/emilypi/smash/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/emilypi/smash/actions/workflows/haskell-ci.yml) [![Hackage](https://img.shields.io/hackage/v/smash.svg)](https://hackage.haskell.org/package/smash)  This package consists of 3 interesting datatypes and their respective monad transformers:

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               smash-version:            0.1.3+version:            0.2.0 synopsis:           Combinators for Maybe types description:   Smash products are like the 'These' datatype, only with a unit. You can@@ -12,15 +12,19 @@ license-file:       LICENSE author:             Emily Pillmore maintainer:         emilypi@cohomolo.gy-copyright:          (c) 2020-2022 Emily Pillmore <emilypi@cohomolo.gy>+copyright:          (c) 2020-2026 Emily Pillmore <emilypi@cohomolo.gy> category:           Data build-type:         Simple-extra-source-files:+extra-doc-files:   CHANGELOG.md   README.md  tested-with:-  GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2+  GHC ==9.6.7+   || ==9.8.4+   || ==9.10.3+   || ==9.12.4+   || ==9.14.1  source-repository head   type:     git@@ -33,18 +37,36 @@     Control.Monad.Trans.Wedge     Data.Can     Data.Smash+    Data.Smash.Internal     Data.Wedge -  other-modules:    Data.Smash.Internal   build-depends:-      base             >=4.12 && <4.17-    , bifunctors       ^>=5.5-    , binary           ^>=0.8-    , deepseq          ^>=1.4-    , hashable         ^>=1.3-    , mtl-    , template-haskell >=2.2 && < 3.0+      base              >=4.15 && <4.23+    , bifunctors        >=5.5 && <5.7+    , binary            ^>=0.8+    , deepseq           >=1.4 && <1.6+    , hashable          >=1.3 && <1.6+    , mtl               >=2.2 && <2.4+    , template-haskell  >=2.2 && <3    hs-source-dirs:   src   default-language: Haskell2010   ghc-options:      -Wall++test-suite smash-tests+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:    test+  main-is:          Main.hs+  build-depends:+      base              >=4.15 && <4.23+    , smash+    , tasty             >=1.4 && <1.6+    , tasty-hunit       >=0.10 && <0.11+    , tasty-quickcheck  >=0.10 && <0.12+    , QuickCheck        >=2.14 && <2.17+    , binary+    , mtl+    , transformers++  ghc-options:      -Wall -threaded -rtsopts -with-rtsopts=-N

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -8,7 +9,7 @@ {-# language Safe #-} -- | -- Module       : Control.Monad.Trans.Can--- Copyright    : (c) 2020-2022 Emily Pillmore+-- Copyright    : (c) 2020-2026 Emily Pillmore -- License      : BSD-3-Clause -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -27,7 +28,10 @@   import Data.Can++#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.State.Class@@ -105,7 +109,7 @@  instance (Semigroup t, MonadRWS r w s m) => MonadRWS r w s (CanT t m) -instance MonadTrans (CanT a) where+instance (Semigroup a) => MonadTrans (CanT a) where   lift = CanT . fmap Eno  instance (MonadError e m, Semigroup e) => MonadError e (CanT e m) where

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -8,7 +9,7 @@ {-# language Safe #-} -- | -- Module       : Control.Monad.Trans.Smash--- Copyright    : (c) 2020-2022 Emily Pillmore+-- Copyright    : (c) 2020-2026 Emily Pillmore -- License      : BSD-3-Clause -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -28,7 +29,9 @@  import Data.Smash +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.State

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -8,7 +9,7 @@ {-# language Safe #-} -- | -- Module       : Control.Monad.Trans.Wedge--- Copyright    : (c) 2020-2022 Emily Pillmore+-- Copyright    : (c) 2020-2026 Emily Pillmore -- License      : BSD-3-Clause -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -26,8 +27,11 @@ ) where  -import Data.Wedge+import Data.Wedge + +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.State.Class@@ -97,7 +101,7 @@  instance (Semigroup t, MonadRWS r w s m) => MonadRWS r w s (WedgeT t m) -instance MonadTrans (WedgeT a) where+instance (Semigroup a) => MonadTrans (WedgeT a) where   lift = WedgeT . fmap There  instance (MonadError e m, Semigroup e) => MonadError e (WedgeT e m) where

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}@@ -11,7 +12,7 @@ {-# LANGUAGE Safe #-} -- | -- Module       : Data.Can--- Copyright    : (c) 2020-2022 Emily Pillmore+-- Copyright    : (c) 2020-2026 Emily Pillmore -- License      : BSD-3-Clause -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -79,7 +80,10 @@ ) where  -import Control.Applicative (Alternative(..), liftA2)+import Control.Applicative (Alternative(..))+#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif import Control.DeepSeq import Control.Monad.Zip import Control.Monad@@ -147,7 +151,7 @@   deriving     ( Eq, Ord, Read, Show     , Generic, Generic1-    , Typeable, Data+    , Data     , TH.Lift     ) 

@@ -10,7 +10,7 @@ {-# LANGUAGE Safe #-} -- | -- Module       : Data.Smash--- Copyright    : (c) 2020-2022 Emily Pillmore+-- Copyright    : (c) 2020-2026 Emily Pillmore -- License      : BSD-3-Clause -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -156,7 +156,7 @@   deriving     ( Eq, Ord, Read, Show     , Generic, Generic1-    , Typeable, Data+    , Data     , TH.Lift     ) 

@@ -1,7 +1,7 @@ {-# language Safe #-} -- | -- Module       : Data.Smash.Internal--- Copyright    : (c) 2020-2022 Emily Pillmore+-- Copyright    : (c) 2020-2026 Emily Pillmore -- License      : BSD-3-Clause -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,

@@ -10,7 +10,7 @@ {-# LANGUAGE Safe #-} -- | -- Module       : Data.Wedge--- Copyright    : (c) 2020-2022 Emily Pillmore+-- Copyright    : (c) 2020-2026 Emily Pillmore -- License      : BSD-3-Clause -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -136,7 +136,7 @@   deriving     ( Eq, Ord, Read, Show     , Generic, Generic1-    , Typeable, Data+    , Data     , TH.Lift     ) 

@@ -0,0 +1,108 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- Copyright (c) 2020-2026 Emily Pillmore+module Main (main) where++import Control.Monad (forM_)+import Control.Monad.State.Strict (modify, runState)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Can+import Control.Monad.Trans.Smash+import Control.Monad.Trans.Wedge+import Data.Bifunctor (bimap)+import Data.Binary (Binary, decodeOrFail, encode)+import Data.Can+import Data.Functor.Identity (Identity(..))+import Data.Smash+import Data.Wedge+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Text.Read (readMaybe)++main :: IO ()+main = defaultMain $ testGroup "smash"+  [ representationTests "Can" genCan+  , representationTests "Smash" genSmash+  , representationTests "Wedge" genWedge+  , testGroup "Conversions and instances"+    [ testProperty "Can projections and swap" $ forAll genCan $ \x ->+        (canFst (swapCan x), canSnd (swapCan x)) === (canSnd x, canFst x)+    , testProperty "Smash pointed-product roundtrip" $ forAll genSmash $ \x ->+        toSmash (fromSmash x) === x+    , testProperty "Smash conversion inverse" $ \(x :: Maybe (Int, Int)) ->+        fromSmash (toSmash x) === x+    , testProperty "Wedge pointed-sum roundtrip" $ forAll genWedge $ \x ->+        toWedge (fromWedge x) === x+    , testProperty "Wedge conversion inverse" $ \(x :: Maybe (Either Int Int)) ->+        fromWedge (toWedge x) === x+    , testProperty "Can swap involution" $ forAll genCan $ \x -> swapCan (swapCan x) === x+    , testProperty "Smash swap involution" $ forAll genSmash $ \x -> swapSmash (swapSmash x) === x+    , testProperty "Wedge swap involution" $ forAll genWedge $ \x -> swapWedge (swapWedge x) === x+    , testProperty "Can bimap composition" $ forAll genCan $ \x ->+        bimap (+1) (*2) (bimap (*3) (subtract 4) x) === bimap ((+1) . (*3)) ((*2) . subtract 4) x+    , testProperty "Smash functor composition" $ forAll genSmash $ \x ->+        fmap (+1) (fmap (*2) x) === fmap ((+1) . (*2)) x+    , testProperty "Wedge traversal identity" $ forAll genWedge $ \x ->+        runIdentity (traverse Identity x) === x+    ]+  , testGroup "Binary constructor tags"+    [ testCase "Can tags remain 0, 1, 2, 3" $ forM_+        [(Non, encode (0 :: Int)), (One 7, encode (1 :: Int) <> encode (7 :: Int)),+         (Eno 9, encode (2 :: Int) <> encode (9 :: Int)),+         (Two 7 9, encode (3 :: Int) <> encode (7 :: Int) <> encode (9 :: Int))] $+          \(x :: Can Int Int, bytes) -> encode x @?= bytes+    , testCase "Smash tags remain 0, 1" $ do+        encode (Nada :: Smash Int Int) @?= encode (0 :: Int)+        encode (Smash 7 9 :: Smash Int Int) @?= encode (1 :: Int) <> encode (7 :: Int) <> encode (9 :: Int)+    , testCase "Wedge tags remain 0, 1, 2" $ do+        encode (Nowhere :: Wedge Int Int) @?= encode (0 :: Int)+        encode (Here 7 :: Wedge Int Int) @?= encode (1 :: Int) <> encode (7 :: Int)+        encode (There 9 :: Wedge Int Int) @?= encode (2 :: Int) <> encode (9 :: Int)+    ]+  , transformerTests+  ]++genCan :: Gen (Can Int Int)+genCan = oneof [pure Non, One <$> arbitrary, Eno <$> arbitrary, Two <$> arbitrary <*> arbitrary]++genSmash :: Gen (Smash Int Int)+genSmash = oneof [pure Nada, Smash <$> arbitrary <*> arbitrary]++genWedge :: Gen (Wedge Int Int)+genWedge = oneof [pure Nowhere, Here <$> arbitrary, There <$> arbitrary]++representationTests :: (Eq a, Show a, Read a, Binary a) => String -> Gen a -> TestTree+representationTests name gen = testGroup name+  [ testProperty "Show/Read roundtrip" $ forAll gen $ \x -> readMaybe (show x) === Just x+  , testProperty "Binary roundtrip consumes all bytes" $ forAll gen $ \x ->+      case decodeOrFail (encode x) of+        Left (_, _, err) -> counterexample err False+        Right (rest, _, y) -> (rest, y) === (mempty, x)+  ]++transformerTests :: TestTree+transformerTests = testGroup "Transformers"+  [ testCase "CanT accumulates left values in bind order" $+      runIdentity (runCanT (CanT (Identity (Two [1] (2 :: Int))) >>= \x ->+        CanT (Identity (Two [3] (x + 1))))) @?= Two [1,3 :: Int] 3+  , testCase "SmashT accumulates left values in bind order" $+      runIdentity (runSmashT (SmashT (Identity (Smash [1] (2 :: Int))) >>= \x ->+        SmashT (Identity (Smash [3] (x + 1))))) @?= Smash [1,3 :: Int] 3+  , testCase "CanT empty and left-only cases skip continuation effects" $+      forM_ [Non, One "error"] $ \x ->+        runState (runCanT (CanT (pure x) >>= \(_ :: Int) -> lift (modify (+1)) >> pure 5)) 0+          @?= (x, 0 :: Int)+  , testCase "SmashT empty case skips continuation effects" $+      runState (runSmashT (SmashT (pure Nada) >>= \(_ :: Int) -> lift (modify (+1)) >> pure 5)) 0+        @?= (Nada :: Smash String Int, 0 :: Int)+  , testCase "WedgeT empty and left cases skip continuation effects" $+      forM_ [Nowhere, Here "error"] $ \x ->+        runState (runWedgeT (WedgeT (pure x) >>= \(_ :: Int) -> lift (modify (+1)) >> pure 5)) 0+          @?= (x, 0 :: Int)+  , testProperty "CanT lift preserves state effects" $ \(n :: Int) ->+      runState (runCanT (lift (modify (+1)) >> pure n)) 0 === (Eno n :: Can String Int, 1 :: Int)+  , testProperty "SmashT lift preserves state effects" $ \(n :: Int) ->+      runState (runSmashT (lift (modify (+1)) >> pure n)) 0 === (Smash "" n, 1 :: Int)+  , testProperty "WedgeT lift preserves state effects" $ \(n :: Int) ->+      runState (runWedgeT (lift (modify (+1)) >> pure n)) 0 === (There n :: Wedge String Int, 1 :: Int)+  ]