coapplicative (empty) → 0.1.0.0
raw patch · 5 files changed
+391/−0 lines, 5 filesdep +basedep +coapplicativedep +comonad
Dependencies added: base, coapplicative, comonad, hedgehog
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- coapplicative.cabal +113/−0
- src/Control/CoApplicative.hs +197/−0
- test/Main.hs +56/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for coapplicative++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2026 J. Carr++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.
+ coapplicative.cabal view
@@ -0,0 +1,113 @@+cabal-version: 3.4+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'coapplicative' generated by+-- 'cabal init'. For further documentation, see:+-- http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name: coapplicative++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.0++-- A short (one-line) description of the package.+synopsis: A dual to applicative: covariant functors which can split++-- A longer description of the package.+description: Provides covariant oplax monoidal functors. These functors+ can be "split" and support pattern-matching while+ retaining the functorial context.+ Default instances are provided for CoApplicatives that+ agree with their Comonad instances,+ as well as a wrapper for (usually non-lawful)+ instances on any Comonad.++-- The license under which the package is released.+license: MIT++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: J. Carr++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer: jcarr250@protonmail.com++-- A copyright notice.+-- copyright:+category: Control+build-type: Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files: CHANGELOG.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++common warnings+ ghc-options: -Wall++library+ -- Import common warning flags.+ import: warnings++ -- Modules exported by the library.+ exposed-modules: Control.CoApplicative++ -- Modules included in this library but not exported.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- Other library packages from which modules are imported.+ build-depends: base ^>=4.20.2.0,+ comonad ^>=5.0.0,++ -- Directories containing source files.+ hs-source-dirs: src++ -- Base language which the package is written in.+ default-language: Haskell2010++test-suite coapplicative-test+ -- Import common warning flags.+ import: warnings++ -- Base language which the package is written in.+ default-language: Haskell2010++ -- Modules included in this executable, other than Main.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- The interface type and version of the test suite.+ type: exitcode-stdio-1.0++ -- Directories containing source files.+ hs-source-dirs: test++ -- The entrypoint to the test suite.+ main-is: Main.hs++ -- Test dependencies.+ build-depends:+ base ^>=4.20.2.0,+ coapplicative,+ comonad,+ hedgehog
+ src/Control/CoApplicative.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE DeriveFunctor, TypeOperators, FlexibleContexts, UndecidableInstances #-}++-- | Provides CoApplicative typeclass and instances.+module Control.CoApplicative (CoApplicative(..), CoAppComonad(..)) where++import Control.Comonad+import Control.Comonad.Trans.Env+import Data.Void+import Data.Functor.Identity (Identity(..))+import Data.List.NonEmpty+import Data.Maybe (mapMaybe)+import Data.Bifunctor+import Data.Functor.Sum+import Data.Coerce+import GHC.Generics++leftToMaybe :: Either a b -> Maybe a+leftToMaybe (Left x) = Just x+leftToMaybe (Right _) = Nothing+rightToMaybe :: Either a b -> Maybe b+rightToMaybe (Left _) = Nothing+rightToMaybe (Right x) = Just x++-- | An opmonoidal functor over the cocartesian structure+-- of Either and Void.+--+-- Laws include associativity, and compatibility with fmap+-- (which implies identity laws)+--+-- either id split . split = either split id . split . fmap reassoc+-- where reassoc is the unique total function of type (Either a (Either b c)) -> Either (Either a b) c+-- split . fmap (either f g) = either (fmap f) (fmap g) . split+-- split . fmap Left = Left+-- split . fmap Right = Right+--+-- Every Comonad is a CoApplicative, but not always in a compatible way+-- with the Comonad structure.+-- In particular, duplicate must distribute with split:+--+-- bimap duplicate duplicate (split wab) = split (fmap split (duplicate wab))+--+class Functor f => CoApplicative f where+ nonempty :: f Void -> Void+ split :: f (Either a b) -> Either (f a) (f b)++ -- | Filter Maybe through the data-structure along Just,+ -- discarding the context of Nothing values+ --+ -- The default implementation biases towards the Left+ splitMaybe :: f (Maybe a) -> Maybe (f a)+ splitMaybe = leftToMaybe . split . fmap maybeToLeft+ where+ maybeToLeft (Just x) = Left x+ maybeToLeft Nothing = Right ()++ -- | Zip a list through the data-structure,+ -- discarding the context of nil values.+ -- I.e. each position in the resulting+ -- list will "collect" the corresponding f a+ splitList :: f [a] -> [f a]+ splitList = roll . maybe Nothing (Just . dorec) . splitMaybe . fmap unroll+ {- TODO: make this fuse? At least on its output -}+ where+ dorec was = (fmap fst was, splitList $ fmap snd was)++ unroll :: [b] -> Maybe (b, [b])+ unroll [] = Nothing+ unroll (x : xs) = Just (x, xs)+ roll :: Maybe (b, [b]) -> [b]+ roll Nothing = []+ roll (Just (x, xs)) = x : xs++instance CoApplicative Identity where+ nonempty (Identity v) = v+ split (Identity (Left x)) = Left (Identity x)+-- This is compatible+ split (Identity (Right y)) = Right (Identity y)++-- | Filters out elements which do not match the head.+instance CoApplicative NonEmpty where+ nonempty (v :| _) = v+ split (Left x :| rest) = Left (x :| mapMaybe leftToMaybe rest)+ split (Right x :| rest) = Right (x :| mapMaybe rightToMaybe rest)++instance (CoApplicative f, CoApplicative g) => CoApplicative (Sum f g) where+ nonempty (InL fv) = nonempty fv+ nonempty (InR gv) = nonempty gv+ split (InL fe) = bimap InL InL (split fe)+ split (InR ge) = bimap InR InR (split ge)+ splitMaybe (InL fm) = InL <$> (splitMaybe fm)+ splitMaybe (InR gm) = InR <$> (splitMaybe gm)+ splitList (InL fxs) = InL <$> (splitList fxs)+ splitList (InR gxs) = InR <$> (splitList gxs)++instance CoApplicative ((,) a) where+ nonempty (_, v) = v+ split (a, Left x) = Left (a, x)+ split (a, Right y) = Right (a, y)++instance CoApplicative ((,,) a b) where+ nonempty (_, _, v) = v+ split (a, b, Left x) = Left (a, b, x)+ split (a, b, Right y) = Right (a, b, y)++instance CoApplicative ((,,,) a b c) where+ nonempty (_, _, _, v) = v+ split (a, b, c, Left x) = Left (a, b, c, x)+ split (a, b, c, Right y) = Right (a, b, c, y)++instance CoApplicative ((,,,,) a b c d) where+ nonempty (_, _, _, _, v) = v+ split (a, b, c, d, Left x) = Left (a, b, c, d, x)+ split (a, b, c, d, Right y) = Right (a, b, c, d, y)++instance CoApplicative ((,,,,,) a b c d e) where+ nonempty (_, _, _, _, _, v) = v+ split (a, b, c, d, e, Left x) = Left (a, b, c, d, e, x)+ split (a, b, c, d, e, Right y) = Right (a, b, c, d, e, y)++instance CoApplicative ((,,,,,,) a b c d e f) where+ nonempty (_, _, _, _, _, _, v) = v+ split (a, b, c, d, e, f, Left x) = Left (a, b, c, d, e, f, x)+ split (a, b, c, d, e, f, Right y) = Right (a, b, c, d, e, f, y)++instance CoApplicative w => CoApplicative (EnvT e w) where+ nonempty (EnvT _ wv) = nonempty wv+ split (EnvT e we) = bimap (EnvT e) (EnvT e) (split we)+ splitMaybe (EnvT e wm) = EnvT e <$> splitMaybe wm+ splitList (EnvT e wxs) = EnvT e <$> splitList wxs++instance CoApplicative f => CoApplicative (M1 i c f) where+ nonempty (M1 fv) = nonempty fv+ split (M1 fab) = coerce (split fab)+ splitMaybe (M1 fa) = M1 <$> splitMaybe fa+ splitList (M1 fxs) = M1 <$> splitList fxs++-- identical to Sum+instance (CoApplicative f, CoApplicative g) => CoApplicative (f :+: g) where+ nonempty (L1 fv) = nonempty fv+ nonempty (R1 gv) = nonempty gv+ split (L1 fe) = bimap L1 L1 (split fe)+ split (R1 ge) = bimap R1 R1 (split ge)+ splitMaybe (L1 fm) = L1 <$> (splitMaybe fm)+ splitMaybe (R1 gm) = R1 <$> (splitMaybe gm)+ splitList (L1 fxs) = L1 <$> (splitList fxs)+ splitList (R1 gxs) = R1 <$> (splitList gxs)++instance (CoApplicative f, CoApplicative g) => CoApplicative (f :.: g) where+ nonempty (Comp1 fgv) = nonempty (nonempty <$> fgv)+ split (Comp1 fgab) =+ coerce $+ split (fmap split fgab)+ splitMaybe (Comp1 fga) = fmap Comp1 $ splitMaybe $ fmap splitMaybe fga+ splitList (Comp1 fgxs) = fmap Comp1 $ splitList $ fmap splitList fgxs++instance CoApplicative Par1 where+ nonempty (Par1 v) = v+ split (Par1 (Left a)) = Left (Par1 a)+ split (Par1 (Right a)) = Right (Par1 a)+ splitMaybe (Par1 m) = Par1 <$> m+ splitList (Par1 xs) = Par1 <$> xs++instance CoApplicative f => CoApplicative (Rec1 f) where+ nonempty (Rec1 fv) = nonempty fv+ split (Rec1 fab) = coerce (split fab)+ splitMaybe (Rec1 fa) = coerce $ splitMaybe fa+ splitList (Rec1 fxs) = coerce $ splitList fxs++instance (Generic1 f, CoApplicative (Rep1 f)) => CoApplicative (Generically1 f) where+ nonempty (Generically1 fa) = nonempty (from1 fa)+ split (Generically1 fab) =+ bimap (Generically1 . to1) (Generically1 . to1)+ (split (from1 fab))+ splitMaybe (Generically1 fa) = fmap Generically1 $ fmap to1 $ splitMaybe $ from1 fa+ splitList (Generically1 fxs) = fmap Generically1 $ fmap to1 $ splitList $ from1 fxs++-- | There is a derivable instance for any Comonad,+-- but this will not be compatible with context shifts for most instances.+-- +-- In the context of pattern-matching, this means that reaching the same branch+-- two different ways may result in conflicting views of the surrounding context.+-- (only the context which lands on the same side of the branch is consistent)+newtype CoAppComonad w a = CoAppComonad { runCoAppComonad :: w a } deriving (Functor)++instance Comonad w => CoApplicative (CoAppComonad w) where+ nonempty (CoAppComonad wv) = extract wv+ split (CoAppComonad wab) =+ case extract wab of+ Left x -> Left (CoAppComonad $ fmap (either id (const x)) wab)+ Right y -> Right (CoAppComonad $ fmap (either (const y) id) wab)++instance Comonad w => Comonad (CoAppComonad w) where+ extract = extract . runCoAppComonad+ {- coerce gets blocked by unknown roles sadly -}+ duplicate (CoAppComonad wa) = CoAppComonad (fmap CoAppComonad (duplicate wa))++
+ test/Main.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveFunctor, DerivingStrategies, DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import GHC.Generics+import Control.CoApplicative+import Data.List.NonEmpty+import Data.Functor.Sum+import Data.Functor.Identity+import Control.Comonad+import Data.Bifunctor++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++data Ex a+ = A (Sum Identity Identity a)+ | B a+ | C (NonEmpty a)+ | D (Int, String, a)+ deriving stock (Generic, Generic1, Functor, Show)+ deriving CoApplicative via (Generically1 Ex)++testCompiles :: IO ()+testCompiles = print (split (B x))+ where+ x :: Either Int Bool+ x = Left 4++someInt :: Gen Int+someInt = Gen.int $ Range.constant 0 10++someInt2 :: Gen Int+someInt2 = Gen.int $ Range.constant 11 20++someInt3 :: Gen Int+someInt3 = Gen.int $ Range.constant 21 30++prop_nonEmptyDupSplit :: Property+prop_nonEmptyDupSplit = property $ do+ xs <- forAll $ Gen.nonEmpty (Range.linear 1 20) $ Gen.either someInt someInt+ bimap duplicate duplicate (split xs) === split (fmap split (duplicate xs))++testProps :: IO Bool+testProps =+ checkParallel $ Group "Properties" [+ ("nonempty_dup_split", prop_nonEmptyDupSplit)+ ]++main :: IO ()+main = do+ testCompiles+ _ <- testProps+ pure ()