diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2020, Emily Pillmore +Copyright (c) 2020-2026, Emily Pillmore All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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: diff --git a/smash.cabal b/smash.cabal --- a/smash.cabal +++ b/smash.cabal @@ -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 +copyright: (c) 2020-2026 Emily Pillmore 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 diff --git a/src/Control/Monad/Trans/Can.hs b/src/Control/Monad/Trans/Can.hs --- a/src/Control/Monad/Trans/Can.hs +++ b/src/Control/Monad/Trans/Can.hs @@ -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 @@ -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 diff --git a/src/Control/Monad/Trans/Smash.hs b/src/Control/Monad/Trans/Smash.hs --- a/src/Control/Monad/Trans/Smash.hs +++ b/src/Control/Monad/Trans/Smash.hs @@ -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 @@ -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 diff --git a/src/Control/Monad/Trans/Wedge.hs b/src/Control/Monad/Trans/Wedge.hs --- a/src/Control/Monad/Trans/Wedge.hs +++ b/src/Control/Monad/Trans/Wedge.hs @@ -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 @@ -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 diff --git a/src/Data/Can.hs b/src/Data/Can.hs --- a/src/Data/Can.hs +++ b/src/Data/Can.hs @@ -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 @@ -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 ) diff --git a/src/Data/Smash.hs b/src/Data/Smash.hs --- a/src/Data/Smash.hs +++ b/src/Data/Smash.hs @@ -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 @@ -156,7 +156,7 @@ deriving ( Eq, Ord, Read, Show , Generic, Generic1 - , Typeable, Data + , Data , TH.Lift ) diff --git a/src/Data/Smash/Internal.hs b/src/Data/Smash/Internal.hs --- a/src/Data/Smash/Internal.hs +++ b/src/Data/Smash/Internal.hs @@ -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 , diff --git a/src/Data/Wedge.hs b/src/Data/Wedge.hs --- a/src/Data/Wedge.hs +++ b/src/Data/Wedge.hs @@ -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 @@ -136,7 +136,7 @@ deriving ( Eq, Ord, Read, Show , Generic, Generic1 - , Typeable, Data + , Data , TH.Lift ) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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) + ]