lr-acts 0.0.1 → 0.1

raw patch · 14 files changed

+2277/−2138 lines, 14 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−21
• LICENSE +28/−28
• README.md +106/−107
• Setup.hs +2/−2
• benchmark/Main.hs +69/−38
• lr-acts.cabal +8/−7
• src/Data/Act.hs +79/−79
• src/Data/Act/Act.hs +784/−773
• src/Data/Act/Cyclic.hs +599/−494
• src/Data/Act/Torsor.hs +207/−210
• src/Data/Semidirect.hs +15/−15
• src/Data/Semidirect/Lazy.hs +139/−144
• src/Data/Semidirect/Strict.hs +139/−144
• test/Spec.hs +75/−76

@@ -1,21 +1,27 @@-# Changelog for `lr-acts`
-
-All notable changes to this project will be documented in this file.
-
-The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
-and this project adheres to the
-[Haskell Package Versioning Policy](https://pvp.haskell.org/).
-
-## 0.0 - 2025-05-22
-
-### Added
-
-- Left and right actions
-- Semigroup, monoid and group actions
-- Cyclic and generated actions
-- Torsors
-- Semidirect products
-
-## 0.0.1 - 2024-05-24
-
-- Fix deriving mechanism for Torsor instances
+# Changelog for `lr-acts`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## 0.0 - 2025-05-22++### Added++- Left and right actions+- Semigroup, monoid and group actions+- Cyclic and generated actions+- Torsors+- Semidirect products++## 0.0.1 - 2024-05-24++- Fix deriving mechanism for Torsor instances++## 0.1 - unreleased++- Rename LSemidirect and RSemidirect constructors to LPair and RPair+- Instances for ActCyclic x ()+- Add LDefault and RDefault newtypes for ActCyclic

@@ -1,28 +1,28 @@-BSD 3-Clause License
-
-Copyright (c) 2024, Alice Rixte
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-1. Redistributions of source code must retain the above copyright notice, this
-   list of conditions and the following disclaimer.
-
-2. Redistributions in binary form must reproduce the above copyright notice,
-   this list of conditions and the following disclaimer in the documentation
-   and/or other materials provided with the distribution.
-
-3. Neither the name of the copyright holder nor the names of its
-   contributors may be used to endorse or promote products derived from
-   this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+BSD 3-Clause License++Copyright (c) 2024, Alice Rixte++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,107 +1,106 @@-# lr-acts
-
-[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/lr-acts.svg)](https://hackage.haskell.org/package/lr-acts)  [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/AliceRixte/lr-acts/LICENSE)
-
-
-## Features
-
-* Left and right actions of
-  * sets
-  * semigroup
-  * monoids
-  * groups
-* Semidirect product
-* Group torsors
-* Cyclic actions
-* Generated actions
-
-
-### Fine-grained class hierarchy
-
-Left and right actions with a fine-grained class hierarchy for action properties. For left actions, here are the provided classes :
-
-``` haskell
-class LAct               -- Set action
- => LActSg               -- Semigroup action
-     => LActMn           -- Monoid action
-          => LTorsor     -- Torsor
- => LActDistrib          -- Distributive action
- => LActNeutral          -- Neutral preserving action
- => LActGen              -- Action generated by a set
-     => LActCyclic       -- Cyclic action (generated by a single element)
-
-```
-
-### Derive most of you action instances
-
-The acting type is always the second parameter. Use this with `DerivingVia` language extension to derive action instances :
-
-``` haskell
-import Data.Act
-import Data.Semigroup
-
-newtype Seconds = Seconds Float
-newtype Duration = Duration Seconds
-  deriving (Semigroup, Monoid) via (Sum Float)
-
-  deriving (LAct Seconds, RAct Seconds) via (ActSelf' (Sum Float))
-  -- derives LAct Second  Duration
-
-  deriving (LAct [Seconds], RAct [Seconds]) via (ActMap (ActSelf' (Sum Float)))
-   -- derives LAct [Second] Duration
-
-newtype Durations = Durations [Duration]
-  deriving (LAct Seconds, RAct Seconds) via (ActFold [Duration])
-  -- derives LAct Second Durations
-
-```
-
-``` haskell
-ghci> Duration 2 `lact` Seconds 3
-Seconds 5.0
-
-ghci> Duration 2 `lact` [Seconds 3, Seconds 4]
-[Seconds 5.0,Seconds 6.0]
-
-ghci> [Duration 2, Duration 3] `lact` Seconds 4
-[Seconds 5.0,Seconds 6.0]
-
-ghci> Durations [Duration 2, Duration 3] `lact` Seconds 4
-Seconds 9.0
-```
-
-### Semidirect products
-
-This fine-grained hierarchy allows to check for associativity and existence of neutral elements using _semidirect products_.
-
-``` haskell
->>> import Data.Semigroup
->>> LSemidirect (Sum 1) (Product 2) <> LSemidirect (Sum (3 :: Int)) (Product (4 :: Int))
-LSemidirect {lactee = Sum {getSum = 7}, lactor = Product {getProduct = 8}}
-```
-
-GHC will complain when using a semigroup action that is not distributive :
-
-```haskell
->>> LSemidirect (Sum 1) (Sum 2) <> LSemidirect (Sum (3 :: Int)) (Sum (4 :: Int))
-No instance for `LActDistrib (Sum Int) (Sum Int)'
-  arising from a use of `<>'
-```
-
-## Comparison with other action libraries
-
-Here is a list of action libraries on hackage :
-
-- [monoid-extra](https://github.com/diagrams/monoid-extras)
-- [acts](https://hackage.haskell.org/package/acts)
-- [semigroup-actions](https://hackage.haskell.org/package/semigroups-actions)
-- [raaz](https://hackage.haskell.org/package/raaz-0.0.1/docs/Raaz-Core-MonoidalAction.html)
-
-
-In comparison with these libraries, `lr-acts`is the only library that :
-- Implements right actions
-- Implements cyclic actions and generated actions
-- Ensures the associativity and the neutrality of `mempty` in semidirect products
-- Proposes several newtypes for deriving instances (note that [acts](https://hackage.haskell.org/package/acts) proposes a deriving mechanism, but centered around the actee type, not the actor type as in this library)
-
-The main drawback of providing right actions and checking properties for semidirect products is that the number of instances can quickly be overwhelming. It can be a lot of boiler plate to declare them all, especially when the acting semigroup is commutative.
+# lr-acts++[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/AliceRixte/lr-acts/LICENSE) [![Hackage](https://img.shields.io/hackage/v/lr-acts.svg)](https://hackage.haskell.org/package/lr-acts) [![Nightly](https://www.stackage.org/package/lr-acts/badge/nightly)](https://www.stackage.org/nightly/package/lr-acts) [![LTS](https://www.stackage.org/package/lr-acts/badge/lts)](https://www.stackage.org/lts/package/lr-acts) ++## Features++* Left and right actions of+  * sets+  * semigroup+  * monoids+  * groups+* Semidirect product+* Group torsors+* Cyclic actions+* Generated actions+++### Fine-grained class hierarchy++Left and right actions with a fine-grained class hierarchy for action properties. For left actions, here are the provided classes :++``` haskell+class LAct               -- Set action+ => LActSg               -- Semigroup action+     => LActMn           -- Monoid action+          => LTorsor     -- Torsor+ => LActDistrib          -- Distributive action+ => LActNeutral          -- Neutral preserving action+ => LActGen              -- Action generated by a set+     => LActCyclic       -- Cyclic action (generated by a single element)++```++### Derive most of you action instances++The acting type is always the second parameter. Use this with `DerivingVia` language extension to derive action instances :++``` haskell+import Data.Act+import Data.Semigroup++newtype Seconds = Seconds Float+newtype Duration = Duration Seconds+  deriving (Semigroup, Monoid) via (Sum Float)++  deriving (LAct Seconds, RAct Seconds) via (ActSelf' (Sum Float))+  -- derives LAct Second  Duration++  deriving (LAct [Seconds], RAct [Seconds]) via (ActMap (ActSelf' (Sum Float)))+   -- derives LAct [Second] Duration++newtype Durations = Durations [Duration]+  deriving (LAct Seconds, RAct Seconds) via (ActFold [Duration])+  -- derives LAct Second Durations++```++``` haskell+ghci> Duration 2 `lact` Seconds 3+Seconds 5.0++ghci> Duration 2 `lact` [Seconds 3, Seconds 4]+[Seconds 5.0,Seconds 6.0]++ghci> [Duration 2, Duration 3] `lact` Seconds 4+[Seconds 5.0,Seconds 6.0]++ghci> Durations [Duration 2, Duration 3] `lact` Seconds 4+Seconds 9.0+```++### Semidirect products++This fine-grained hierarchy allows to check for associativity and existence of neutral elements using _semidirect products_.++``` haskell+>>> import Data.Semigroup+>>> LSemidirect (Sum 1) (Product 2) <> LSemidirect (Sum (3 :: Int)) (Product (4 :: Int))+LSemidirect {lactee = Sum {getSum = 7}, lactor = Product {getProduct = 8}}+```++GHC will complain when using a semigroup action that is not distributive :++```haskell+>>> LSemidirect (Sum 1) (Sum 2) <> LSemidirect (Sum (3 :: Int)) (Sum (4 :: Int))+No instance for `LActDistrib (Sum Int) (Sum Int)'+  arising from a use of `<>'+```++## Comparison with other action libraries++Here is a list of action libraries on hackage :++- [monoid-extra](https://github.com/diagrams/monoid-extras)+- [acts](https://hackage.haskell.org/package/acts)+- [semigroup-actions](https://hackage.haskell.org/package/semigroups-actions)+- [raaz](https://hackage.haskell.org/package/raaz-0.0.1/docs/Raaz-Core-MonoidalAction.html)+++In comparison with these libraries, `lr-acts`is the only library that :+- Implements right actions+- Implements cyclic actions and generated actions+- Ensures the associativity and the neutrality of `mempty` in semidirect products+- Proposes several newtypes for deriving instances (note that [acts](https://hackage.haskell.org/package/acts) proposes a deriving mechanism, but centered around the actee type, not the actor type as in this library)++The main drawback of providing right actions and checking properties for semidirect products is that the number of instances can quickly be overwhelming. It can be a lot of boiler plate to declare them all, especially when the acting semigroup is commutative.

@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,38 +1,69 @@-module Main (main) where
-
-import Criterion.Main
-
-import Data.Semidirect.Lazy as L
-import Data.Semidirect.Strict as S
-
-import Data.Monoid
-import Data.Semigroup
-
-stimesLSemiLazy :: Int -> Sum Int
-stimesLSemiLazy n =   L.lactee $ stimes n
-    (L.LSemidirect (Sum 1) (Product 2) :: L.LSemidirect (Sum Int) (Product Int))
-
-stimesLSemiStrict :: Int -> Sum Int
-stimesLSemiStrict n =
-  S.lactee $ stimes n
-    (S.LSemidirect (Sum 1) (Product 2) :: S.LSemidirect (Sum Int) (Product Int))
-
-sumProduct :: Int  -> (Sum Int, Product Int)
-sumProduct n = stimes n (Sum 1, Product 2)
-
-mkBench f n = bench (show n) $ nf f n
-
-pow10list :: Int -> Int -> [Int]
-pow10list a b = [10 ^n | n <- [a..b]]
-
-nlist  :: [Int]
-nlist = pow10list 1 4
-
-
-main :: IO ()
-main =
-    defaultMain [
-        bgroup "Lazy pair (,)"      (fmap (mkBench sumProduct)      nlist)
-      , bgroup "Lazy LSemidirect"   (fmap (mkBench stimesLSemiLazy) nlist)
-      , bgroup "Strict LSemidirect" (fmap (mkBench stimesLSemiStrict) nlist)
-    ]+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE TypeOperators    #-}+{-# OPTIONS_GHC -ddump-to-file #-}++module Main (main) where++import Criterion.Main++import Data.Semidirect.Lazy as L+import Data.Semidirect.Strict as S++import Data.Monoid+import Data.Semigroup+import Data.Act++import GHC.Real++--------------------------------- Semidirect ---------------------------------++stimesLSemiLazy :: Int -> Sum Int+stimesLSemiLazy n =   L.lactee $ stimes n+    (L.LSemidirect (Sum 1) (Product 2) :: L.LSemidirect (Sum Int) (Product Int))++stimesLSemiStrict :: Int -> Sum Int+stimesLSemiStrict n =+  S.lactee $ stimes n+    (S.LSemidirect (Sum 1) (Product 2) :: S.LSemidirect (Sum Int) (Product Int))++sumProduct :: Int  -> (Sum Int, Product Int)+sumProduct n = stimes n (Sum 1, Product 2)++--------------------------------- LDefault  ----------------------------------++mulDef :: Int -> Double+mulDef 0 = 0+mulDef n = lorigin @(LDefault (2 :% 3) Double) + mulDef (n-1)++mulDouble :: Int -> Double+mulDouble 0 = 0+mulDouble n = 2/3 + mulDouble (n-1)++++------------------------------------------------------------------------------++mkBench f n = bench (show n) $ nf f n++pow10list :: Int -> Int -> [Int]+pow10list a b = [10 ^n | n <- [a..b]]++nlist  :: [Int]+nlist = pow10list 1 4+++main :: IO ()+main =+    defaultMain+      [  bgroup "ActCyclic" [+          bgroup "Double "            (fmap (mkBench mulDouble)      nlist)+        , bgroup "LDefault Ratio"     (fmap (mkBench mulDef)      nlist)+        ]++      , bgroup "Semidirect" [+          bgroup "Lazy pair (,)"      (fmap (mkBench sumProduct)      nlist)+        , bgroup "Lazy LSemidirect"   (fmap (mkBench stimesLSemiLazy) nlist)+        , bgroup "Strict LSemidirect" (fmap (mkBench stimesLSemiStrict) nlist)+        ]+      ]

@@ -1,11 +1,11 @@-cabal-version: 2.2
+cabal-version: 2.2  -- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           lr-acts-version:        0.0.1+version:        0.1 synopsis:       Left and right actions, semidirect products and torsors description:    Please see the README on GitHub at <https://github.com/AliceRixte/lr-acts/blob/main/README.md> category:       Algebra, Math, Data@@ -13,11 +13,12 @@ bug-reports:    https://github.com/AliceRixte/lr-acts/issues author:         Alice Rixte maintainer:     alice.rixte@u-bordeaux.fr+copyright:      (c) Alice Rixte 2025 license:        BSD-3-Clause license-file:   LICENSE build-type:     Simple tested-with:-    GHC == 9.8.2+    GHC == 9.8.2 || == 9.10.2 || == 9.10.3 extra-source-files:     README.md extra-doc-files:@@ -47,7 +48,7 @@       base >=4.18 && <5     , data-default >=0.7 && <0.9     , groups ==0.5.*-  default-language: Haskell2010+  default-language: GHC2024  test-suite lr-acts-test   type: exitcode-stdio-1.0@@ -58,7 +59,7 @@       Paths_lr_acts   hs-source-dirs:       test-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -threaded   build-depends:       QuickCheck >=2.14.3     , base >=4.18 && <5@@ -66,7 +67,7 @@     , groups ==0.5.*     , hspec >=2.11     , lr-acts-  default-language: Haskell2010+  default-language: GHC2024  benchmark lr-acts-bench   type: exitcode-stdio-1.0@@ -84,4 +85,4 @@     , data-default >=0.7 && <0.9     , groups ==0.5.*     , lr-acts-  default-language: Haskell2010+  default-language: GHC2024

@@ -1,80 +1,80 @@-
-
---------------------------------------------------------------------------------
--- |
---
--- Module      :  Data.Act
--- Description :  Actions of sets, semigroups, monoids or groups.
--- Copyright   :  (c) Alice Rixte 2024
--- License     :  BSD 3
--- Maintainer  :  alice.rixte@u-bordeaux.fr
--- Stability   :  unstable
--- Portability :  non-portable (GHC extensions)
---
--- == Presentation
---
--- An action lifts an element (the "/actor/") of some type @s@, the /acting/
--- type, into a function of another type @x@ which we call the "/actee/".
---
--- The class hierarchy for actions is fine-grained, which means it is flexible
--- but sometimes cumbersome to deal with. In particular, this allows to specify
--- specific properties on the action for a semidirect product to be a semigroup
--- or a monoid (see @'Data.Semidirect'@). Here is a tree summarizing the class
--- hierarchy and their laws:
---
--- @
--- 'LAct'                     /Set action/
---  => 'LActSg'               /Semigroup action/
---      => 'LActMn'           /Monoid action/
---           => 'LTorsor'     /Torsor/
---  => 'LActDistrib'          /Distributive action/
---  => 'LActNeutral'          /Neutral preserving action/
---  => 'LActGen'              /Action generated by a set/
---      => 'LActCyclic'       /Cyclic action (generated by a single element)/
--- @
---
---
--- == Instances driven by the acting type
---
--- The action classes do not have functional dependencies, which can make it
--- awkward to work with them. To avoid overlapping issues, this library chooses
--- to drive instances by the second parameter, i.e. to _never_ write instances
--- of the form
---
--- @
--- instance LAct SomeType s
--- instance RAct SomeType s
--- @
---
---
--- If you need such an instance, you should make a newtype. This library already
--- provides some, such as @'ActSelf'@,  @'ActTrivial'@, @'ActSelf''@, @'ActFold''@
--- and @'ActMap'@.
---
--- == Design choices compared to existing libraries
---
--- This library is inspired by the already existing action libraries.
---
--- * The deriving mechanism is inspired by the one from the @acts@ library. The
---   main difference between this library and the @acts@ library is that  @acts@
---   drives its instances by the actee parameter.
---
--- * The @monoid-extras@ library drives its instances by the acting type, but
---   does not provide a deriving mechanism. This library started as an extension
---   of @monoid-extras@, but the design choices made it diverge from it.
---
--- * The idea of specifying action properties using empty classes comes from the
---   @semigroups-actions@ library, which inspired some design of this library.
---   This library offers everything @semigroups-actions@ offers, and more.
---
---------------------------------------------------------------------------------
-
-module Data.Act
-  ( module Data.Act.Act
-  , module Data.Act.Torsor
-  , module Data.Act.Cyclic
-  ) where
-
-import Data.Act.Act
-import Data.Act.Torsor
+++--------------------------------------------------------------------------------+-- |+--+-- Module      :  Data.Act+-- Description :  Actions of sets, semigroups, monoids or groups.+-- Copyright   :  (c) Alice Rixte 2024+-- License     :  BSD 3+-- Maintainer  :  alice.rixte@u-bordeaux.fr+-- Stability   :  unstable+-- Portability :  non-portable (GHC extensions)+--+-- == Presentation+--+-- An action lifts an element (the "/actor/") of some type @s@, the /acting/+-- type, into a function of another type @x@ which we call the "/actee/".+--+-- The class hierarchy for actions is fine-grained, which means it is flexible+-- but sometimes cumbersome to deal with. In particular, this allows to specify+-- specific properties on the action for a semidirect product to be a semigroup+-- or a monoid (see @'Data.Semidirect'@). Here is a tree summarizing the class+-- hierarchy and their laws:+--+-- @+-- 'LAct'                     /Set action/+--  => 'LActSg'               /Semigroup action/+--      => 'LActMn'           /Monoid action/+--           => 'LTorsor'     /Torsor/+--  => 'LActDistrib'          /Distributive action/+--  => 'LActNeutral'          /Neutral preserving action/+--  => 'LActGen'              /Action generated by a set/+--      => 'LActCyclic'       /Cyclic action (generated by a single element)/+-- @+--+--+-- == Instances driven by the acting type+--+-- The action classes do not have functional dependencies, which can make it+-- awkward to work with them. To avoid overlapping issues, this library chooses+-- to drive instances by the second parameter, i.e. to _never_ write instances+-- of the form+--+-- @+-- instance LAct SomeType s+-- instance RAct SomeType s+-- @+--+--+-- If you need such an instance, you should make a newtype. This library already+-- provides some, such as @'ActSelf'@,  @'ActTrivial'@, @'ActSelf''@, @'ActFold''@+-- and @'ActMap'@.+--+-- == Design choices compared to existing libraries+--+-- This library is inspired by the already existing action libraries.+--+-- * The deriving mechanism is inspired by the one from the @acts@ library. The+--   main difference between this library and the @acts@ library is that  @acts@+--   drives its instances by the actee parameter.+--+-- * The @monoid-extras@ library drives its instances by the acting type, but+--   does not provide a deriving mechanism. This library started as an extension+--   of @monoid-extras@, but the design choices made it diverge from it.+--+-- * The idea of specifying action properties using empty classes comes from the+--   @semigroups-actions@ library, which inspired some design of this library.+--   This library offers everything @semigroups-actions@ offers, and more.+--+--------------------------------------------------------------------------------++module Data.Act+  ( module Data.Act.Act+  , module Data.Act.Torsor+  , module Data.Act.Cyclic+  ) where++import Data.Act.Act+import Data.Act.Torsor import Data.Act.Cyclic

@@ -1,773 +1,784 @@-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE DerivingVia                #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE ConstraintKinds            #-}
-
---------------------------------------------------------------------------------
--- |
---
--- Module      :  Data.Act.Act
--- Description :  Actions of sets, semigroups, monoids and groups.
--- Copyright   :  (c) Alice Rixte 2024
--- License     :  BSD 3
--- Maintainer  :  alice.rixte@u-bordeaux.fr
--- Stability   :  unstable
--- Portability :  non-portable (GHC extensions)
---
--- = Usage
---
--- For both @'LAct'@ and @'RAct'@, the acting type is the second parameter. This
--- is a bit counter intuitive when using @'LAct'@, but it allows to use the
--- @DerivingVia@ mechanism to derive instances of @'LAct'@ and @'RAct'@ for
--- newtypes that wrap the acting type. For example, you can use @'ActSelf''@ as
--- follow to derive instances for @'LAct'@ and @'RAct'@ :
---
--- @
--- {-# LANGUAGE DerivingVia #-}
---
--- import Data.Act
--- import Data.Semigroup
---
--- newtype Seconds = Seconds Float
--- newtype Duration = Duration Seconds
---   deriving (Semigroup, Monoid) via (Sum Float)
---
---   deriving ('LAct' Seconds, 'RAct' Seconds) via ('ActSelf'' (Sum Float))
---   -- derives LAct Second  Duration
---
---   deriving ('LAct' [Seconds], RAct [Seconds]) via ('ActMap' ('ActSelf'' (Sum Float)))
---    -- derives LAct [Second] Duration
---
--- newtype Durations = Durations [Duration]
---   deriving ('LAct' Seconds, 'RAct' Seconds) via ('ActFold' [Duration])
---   -- derives LAct Second Durations
--- @
--- >>> Duration (Seconds 1) <>$ (Seconds 2)
--- Seconds 3.0
--- >>> Duration 2 <>$ Seconds 3
--- Seconds 5.0
--- >>> Duration 2 <>$ [Seconds 3, Seconds 4]
--- [Seconds 5.0,Seconds 6.0]
--- >>> [Duration 2, Duration 3] <>$ Seconds 4
--- [Seconds 5.0,Seconds 6.0]
--- >>> Durations [Duration 2, Duration 3] <>$ Seconds 4
--- Seconds 9.0
---
---------------------------------------------------------------------------------
-
-module Data.Act.Act
-  ( -- * Left actions
-    LAct (..)
-  , LActSg
-  , LActMn
-  , LActGp
-  , LActDistrib
-  , LActSgMorph
-  , LActNeutral
-  , LActMnMorph
-  -- * Right actions
-  , RAct (..)
-  , RActSg
-  , RActMn
-  , RActGp
-  , RActDistrib
-  , RActSgMorph
-  , RActNeutral
-  , RActMnMorph
-  -- * Newtypes for instance derivation
-  , ActSelf (..)
-  , ActSelf' (..)
-  , ActMap (..)
-  , ActFold (..)
-  , ActFold' (..)
-  , ActTrivial (..)
-) where
-
-import Data.Semigroup as Sg
-import Data.Monoid as Mn
-import Data.Group
-import Data.Functor.Identity
-import Data.Foldable
-import Data.Coerce
-
-
--- | A left action of a set @s@ on another set @x@ is a function that maps
--- elements of @s@ to functions on @x@.
---
--- There are no additional laws for this class to satisfy.
---
--- The order @'LAct'@'s arguments is counter intuitive : even though we write
--- left actions as @s <>$ x@, we declare the constraint as @LAct x s@. The
--- reason for this is to be able to derive instances of @LAct@ while driving the
--- instances by the acting type.
---
--- Instances of @LAct@ are driven by the second parameter (the acting type).
--- Concretely, this means you should never write instances of the form
---
--- @instance LAct SomeType s@
---
--- where @s@ is a type variable.
---
-
---
-class LAct x s where
-  {-# MINIMAL lact | (<>$) #-}
-  -- | Lifts an element of the set @s@ into a function on the set @x@
-  lact :: s -> x -> x
-  lact = (<>$)
-  {-# INLINE lact #-}
-  infixr 5 `lact`
-
-  -- | Infix synonym or @'lact'@
-  --
-  -- The acting part is on the right of the operator (symbolized by @<>@) and
-  -- the actee on the right (symbolized by @$@), hence the notation @<>$@
-  (<>$) :: s -> x -> x
-  (<>$) = lact
-  {-# INLINE (<>$) #-}
-  infixr 5 <>$
-
--- | A left semigroup action
---
--- Instances must satisfy the following law :
---
--- @ (s <> t) <>$ x == s <>$ (t <>$ x) @
---
-class (LAct x s, Semigroup s) => LActSg x s
-
--- | A left monoid action, also called a left /unitary/ action.
---
--- In addition to the laws of @'LActSg'@, instances must satisfy the following
--- law :
---
--- @ 'mempty' <>$ x == x @
---
-class (LActSg x s, Monoid s) => LActMn x s
-
--- | A left action of groups. No additional laws are needed.
---
-type LActGp x s = (LActMn x s, Group s)
-
-
--- | A left distributive action
---
--- Instances must satisfy the following law :
---
--- @ s <>$ (x <> y) == (s <>$ x) <> (s <>$ y) @
---
-class (LAct x s, Semigroup x) => LActDistrib x s
-
--- | A left action by morphism of semigroups
---
--- Whenever the constaints @'LActSg' x s@ and @'LActDistrib' x s@ are satisfied,
--- @(s <>$)@ is a morphism of semigroups for any @s@.
---
-type LActSgMorph x s =  (LActSg x s, LActDistrib x s)
-
-
-
--- | A left action on a monoid that preserves its neutral element.
---
--- Instances must satisfy the following law :
---
--- @ s <>$ 'mempty' == 'mempty' @
---
-class (LAct x s, Monoid x) => LActNeutral x s
-
-
-
--- | A left action by morphism of monoids i.e. such that @(s <>$)@ is a morphism of monoids.
---
--- This is equivalent to satisfy the three following properties :
---
--- 1. left action by morphism of semigroups (i.e. @'LActSgMorph' x s@)
--- 2. left monoid action (i.e. @'LActMn' x s@)
--- 3. preseving neutral element (i.e. @'LActNeutral' x s@)
---
-type LActMnMorph x s = (LActMn x s, LActSgMorph x s, LActNeutral x s)
-
-
--- | A right action of a set @s@ on another set @x@.
---
--- There are no additional laws for this class to satisfy.
---
-class RAct x s where
-  {-# MINIMAL ract | ($<>) #-}
-  -- | Act on the right of some element of @x@
-  ract :: x -> s -> x
-  ract = ($<>)
-  {-# INLINE ract #-}
-  infixl 5 `ract`
-
-  -- | Infix synonym or @'ract'@
-  --
-  -- The acting part is on the right of the operator (symbolized by @<>@) and
-  -- the actee on the left (symbolized by @$@), hence the notation @$<>@.
-  --
-  ($<>) :: x -> s -> x
-  ($<>) = ract
-  {-# INLINE ($<>) #-}
-  infixl 5 $<>
-
-
--- | A right semigroup action
---
--- Instances must satisfy the following law :
---
--- @ x $<> (s <> t) == (x $<> s) $<> t @
---
-class (RAct x s, Semigroup s) => RActSg x s
-
--- | A right monoid action, also called a right /unitary/ action.
---
--- In addition to the laws of @'RActSg'@, instances must satisfy the following
--- law :
---
--- @ x $<> 'mempty' == x @
---
-class (RActSg x s, Monoid s) => RActMn x s
-
--- | A left action of groups. No additional laws are needed.
---
-type RActGp x s = (RActMn x s, Group s)
-
--- | A right distributive action
---
--- Instances must satisfy the following law :
---
--- @ (x <> y) $<> s == (x $<> s) <> (y $<> s) @
---
-class (RAct x s, Semigroup x) => RActDistrib x s
-
-
--- | A right action by morphism of semigroups
---
--- Whenever the constaints @'RActSg' x s@ and @'RActDistrib' x s@ are satisfied,
--- @($<> s)@ is a morphism of semigroups for any @s@.
---
-type RActSgMorph x s =  (RActSg x s, RActDistrib x s)
-
-
--- | A right action on a monoid that preserves its neutral element.
---
--- Instances must satisfy the following law :
---
--- @ x $<> mempty == x @
---
-class (RAct x s, Monoid x) => RActNeutral x s
-
--- | A right action by morphism of monoids i.e. such that
---
--- @($<> s)@ is a morphism of monoids
---
-type RActMnMorph x s = (RActMn x s, RActSgMorph x s, RActNeutral x s)
-
-
-
-
-------------------------------- Newtype actions --------------------------------
-
--- | A semigroup always acts on itself by translation.
---
--- Notice that whenever there is an instance @LAct x s@ with @x@ different from
--- @s@, this action is lifted to an @ActSelf@ action.
---
--- >>> ActSelf "Hello" <>$ " World !"
--- "Hello World !"
---
-newtype ActSelf s = ActSelf {unactSelf :: s}
-  deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, Group)
-
--- | Semigroup action (monoid action when @Monoid s@)
-instance Semigroup s => LAct s (ActSelf s) where
-  ActSelf s <>$ x = s <> x
-  {-# INLINE (<>$) #-}
-
-instance Semigroup s => LActSg s (ActSelf s)
-instance Monoid s => LActMn s (ActSelf s)
-
--- | Semigroup action (monoid action when @Monoid s@)
-instance Semigroup s => RAct s (ActSelf s) where
-  x $<> ActSelf s = x <> s
-  {-# INLINE ($<>) #-}
-
-instance Semigroup s => RActSg s (ActSelf s)
-instance Monoid s => RActMn s (ActSelf s)
-
--- | Actions of @ActSelf'@ behave similarly to those of @'ActSelf'@, but first
--- try to coerce @x@ to @s@ before using the @Semigroup@ instance. If @x@ can be
--- coerced to @s@, then we use the @ActSelf@ action.
---
--- This is meant to be used in conjunction with the @deriving via@ strategy when
--- defining newtype wrappers. Here is a concrete example, where durations act on
--- time. Here, @Seconds@ is not a semigroup and @Duration@ is a group that acts
--- on time via the derived instance @LAct Seconds Duration@.
---
--- @
--- import Data.Semigroup
---
--- newtype Seconds = Seconds Float
---
--- newtype Duration = Duration Seconds
---   deriving ('Semigroup', 'Monoid', 'Group') via ('Sum' Float)
---   deriving ('LAct' Seconds) via ('ActSelf'' ('Sum' Float))
--- @
---
--- >>> Duration 2 <>$ Seconds 3
--- Seconds 5.0
---
-newtype ActSelf' x = ActSelf' {unactCoerce :: x}
-  deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, Group)
-
--- | Semigroup action (monoid action when @Monoid s@)
-instance {-# OVERLAPPABLE #-} (Semigroup s, Coercible x s)
-  => LAct x (ActSelf' s) where
-  ActSelf' s <>$ x = coerce $ s <> (coerce x :: s)
-  {-# INLINE (<>$) #-}
-
-instance (Coercible x s, Semigroup s) => LActSg x (ActSelf' s)
-instance (Coercible x s, Monoid s) => LActMn x (ActSelf' s)
-
--- | Semigroup action (monoid action when @Monoid s@)
-instance {-# OVERLAPPABLE #-} (Semigroup s, Coercible x s)
-  => RAct x (ActSelf' s) where
-  x $<> ActSelf' s = coerce $ (coerce x :: s) <> s
-  {-# INLINE ($<>) #-}
-
-instance (Coercible x s, Semigroup s) => RActSg x (ActSelf' s)
-instance (Coercible x s, Monoid s) => RActMn x (ActSelf' s)
-
--- | The trivial action where any element of @s@ acts as the identity function
--- on @x@
---
--- >>> ActTrivial "Hello !" <>$ "Hi !"
--- " Hi !"
-
-newtype ActTrivial x = ActTrivial  {unactId :: x}
-  deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, Group)
-
--- | Action by morphism of monoids when @'Monoid' s@ and @'Monoid' x@
-instance LAct x (ActTrivial s) where
-  (<>$) _ = id
-  {-# INLINE (<>$) #-}
-
-instance Semigroup s => LActSg x (ActTrivial s)
-instance Monoid s => LActMn x (ActTrivial s)
-instance Semigroup x => LActDistrib x (ActTrivial s)
-instance Monoid x => LActNeutral x (ActTrivial s)
-
--- | Action by morphism of monoids when @'Monoid' s@ and @'Monoid' x@
-instance RAct x (ActTrivial s) where
-  x $<> _ = x
-  {-# INLINE ($<>) #-}
-
-instance Semigroup s => RActSg x (ActTrivial s)
-instance Monoid s => RActMn x (ActTrivial s)
-instance Semigroup x => RActDistrib x (ActTrivial s)
-instance Monoid x => RActNeutral x (ActTrivial s)
-
--- | An action on any functor that uses the @fmap@ function. For example :
---
--- >>> ActMap (ActSelf "Hello") <>$ [" World !", " !"]
--- ["Hello World !","Hello !"]
---
-newtype ActMap s = ActMap {unactMap :: s}
-  deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, Group)
-
--- | Preserves the semigroup (resp. monoid) property of @'LAct' x s@, but
--- __not__ the morphism properties, which depend on potential @'Semigroup'@
--- (resp. @'Monoid'@) instances of @f x@
-instance (LAct x s, Functor f) => LAct (f x) (ActMap s) where
-  ActMap s <>$ x = fmap (s <>$) x
-  {-# INLINE (<>$) #-}
-
-instance (LActSg x s, Functor f) => LActSg (f x) (ActMap s)
-instance (LActMn x s, Functor f) => LActMn (f x) (ActMap s)
-instance LAct x s => LActDistrib [x] (ActMap s)
-instance LAct x s => LActNeutral [x] (ActMap s)
-
-
--- | Preserves the semigroup (resp. monoid) property of @'LAct' x s@, but
--- __not__ the morphism properties, which depend on potential @'Semigroup'@
--- (resp. @'Monoid'@) instances of @f x@. When $f = []@, this is an action by morphism of monoids.
-instance (RAct x s, Functor f) => RAct (f x) (ActMap s) where
-  x $<> ActMap s = fmap ($<> s) x
-  {-# INLINE ($<>) #-}
-
-instance (RActSg x s, Functor f) => RActSg (f x) (ActMap s)
-instance (RActMn x s, Functor f) => RActMn (f x) (ActMap s)
-instance RAct x s => RActDistrib [x] (ActMap s)
-instance RAct x s => RActNeutral [x] (ActMap s)
-
--- | Lifting an a container as an action using @'foldr'@ (for /left/ actions) or
--- @'foldl'@ (for /right/ actions). For a strict version, use @'ActFold''@.
---
--- A left action @(<>$)@ can be seen as an operator for the @'foldr'@ function,
--- and a allowing to lift any action to some @'Foldable'@ container.
---
--- >> ActFold [Sum (1 :: Int), Sum 2, Sum 3] <>$ (4 :: Int)
--- >  10
---
-newtype ActFold s = ActFold {unactFold :: s}
-  deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, Group)
-
--- | When used with lists @[]@, this is a monoid action
-instance (Foldable f, LAct x s) => LAct x (ActFold (f s)) where
-  ActFold f <>$ x = foldr (<>$) x f
-  {-# INLINE (<>$) #-}
-
-instance LAct x s => LActSg x (ActFold [s])
-
--- | When used with lists @[]@, this is a monoid action
-instance (Foldable f, RAct x s) => RAct x (ActFold (f s)) where
-  x $<> ActFold f = foldl ($<>) x f
-  {-# INLINE ($<>) #-}
-
--- | Lifting an a container as an action using @'fold'r'@ (for /left/ actions)
--- or @'foldl''@ (for /right/ actions). For a lazy version, use @'ActFold'@.
---
--- A left action @(<>$)@ can be seen as an operator for the @'foldr'@ function,
--- and a allowing to lift any action to some @'Foldable'@ container.
---
--- >>> ActFold' [Sum (1 :: Int), Sum 2, Sum 3] <>$ (4 :: Int)
--- 10
---
-newtype ActFold' s = ActFold' {unactFold' :: s}
-  deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, Group)
-
--- | When used with lists @[]@, this is a monoid action
-instance (Foldable f, LAct x s) => LAct x (ActFold' (f s)) where
-  ActFold' f <>$ x = foldr' (<>$) x f
-  {-# INLINE (<>$) #-}
-
-instance LAct x s => LActSg x (ActFold' [s])
-
--- | When used with lists @[]@, this is a monoid action
-instance (Foldable f, RAct x s) => RAct x (ActFold' (f s)) where
-  x $<> ActFold' f = foldl' ($<>) x f
-  {-# INLINE ($<>) #-}
-
-
----------------------------------- Instances -----------------------------------
-
--- | Action by morphism of monoids
-instance LAct x () where
-  () <>$ x = x
-  {-# INLINE (<>$) #-}
-
-instance LActSg x ()
-instance LActMn x ()
-instance Semigroup x => LActDistrib x ()
-instance Monoid x => LActNeutral x ()
-
--- | Monoid action
-instance RAct x () where
-  x $<> () = x
-  {-# INLINE ($<>) #-}
-
-instance RActSg x ()
-instance RActMn x ()
-instance Semigroup x => RActDistrib x ()
-instance Monoid x => RActNeutral x ()
-
--- |  Action by morphism of semigroups (resp. monoids) when @'Semigroup' s@
--- (resp. @'Monoid' s@)
-instance {-# INCOHERENT #-} LAct () s where
-  _ <>$ () = ()
-  {-# INLINE (<>$) #-}
-
-instance {-# INCOHERENT #-} Semigroup s =>LActSg () s
-instance {-# INCOHERENT #-} Monoid s =>  LActMn () s
-instance {-# INCOHERENT #-} LActDistrib () s
-instance {-# INCOHERENT #-} LActNeutral () s
-
--- |  Action by morphism of semigroups (resp. monoids) when @'Semigroup' s@
--- (resp. @'Monoid' s@)
-instance {-# INCOHERENT #-} RAct () s where
-  () $<> _ = ()
-  {-# INLINE ($<>) #-}
-
-instance {-# INCOHERENT #-} Semigroup s => RActSg () s
-instance {-# INCOHERENT #-} Monoid s => RActMn () s
-instance {-# INCOHERENT #-} RActDistrib () s
-instance {-# INCOHERENT #-} RActNeutral () s
-
--- | Monoid action when @'LAct' x s@ is a semigroup action.
-instance LAct x s => LAct x (Maybe s) where
-  Nothing <>$ x = x
-  Just s <>$ x = s <>$ x
-
-instance LActSg x s => LActSg x (Maybe s)
-instance LActSg x s => LActMn x (Maybe s)
-
--- | Monoid action when @'LAct' x s@ is a semigroup action.
-instance RAct x s => RAct x (Maybe s) where
-  x $<> Nothing = x
-  x $<> Just s = x $<> s
-
-instance RActSg x s => RActSg x (Maybe s)
-instance RActSg x s => RActMn x (Maybe s)
-
--- | Same action propety as the weaker properties of @('LAct' x1 s1, 'LAct' x2
--- s2)@
-instance (LAct x1 s1, LAct x2 s2) => LAct (x1, x2) (s1, s2) where
-  (s1, s2) <>$ (x1, x2) = (s1 <>$ x1, s2 <>$ x2)
-
-instance (LActSg x1 s1, LActSg x2 s2) => LActSg (x1, x2) (s1, s2)
-instance (LActMn x1 s1, LActMn x2 s2) => LActMn (x1, x2) (s1, s2)
-instance (LActDistrib x1 s1, LActDistrib x2 s2) => LActDistrib (x1, x2) (s1, s2)
-instance (LActNeutral x1 s1, LActNeutral x2 s2) => LActNeutral (x1, x2) (s1, s2)
-
--- | Same action propety as the weaker properties of @('LAct' x1 s1, 'LAct' x2
--- s2)@
-instance (RAct x1 s1, RAct x2 s2) => RAct (x1, x2) (s1, s2) where
-  (x1, x2) $<> (s1, s2) = (x1 $<> s1, x2 $<> s2)
-
-instance (RActSg x1 s1, RActSg x2 s2) => RActSg (x1, x2) (s1, s2)
-instance (RActMn x1 s1, RActMn x2 s2) => RActMn (x1, x2) (s1, s2)
-instance (RActDistrib x1 s1, RActDistrib x2 s2) => RActDistrib (x1, x2) (s1, s2)
-instance (RActNeutral x1 s1, RActNeutral x2 s2) => RActNeutral (x1, x2) (s1, s2)
-
--- | No additionnal properties. In particular this is _not_ a semigroup action.
-instance (LAct x s, LAct x t) => LAct x (Either s t) where
-  (Left  s) <>$ x = s <>$ x
-  (Right s) <>$ x = s <>$ x
-
--- | No additionnal properties. In particular this is _not_ a semigroup action.
-instance (RAct x s, RAct x t) => RAct x (Either s t) where
-  x $<> (Left  s) = x $<> s
-  x $<> (Right s) = x $<> s
-
-
--------------------- Instances for base library functors ---------------------
-
--- | Preserves action properties of @'LAct' x s@.
-instance LAct x s => LAct x (Identity s) where
-  Identity s <>$ x = s <>$ x
-  {-# INLINE (<>$) #-}
-
-instance LActSg x s => LActSg x (Identity s)
-instance LActMn x s => LActMn x (Identity s)
-instance LActDistrib x s => LActDistrib x (Identity s)
-instance LActNeutral x s => LActNeutral x (Identity s)
-
-
--- | Preserves action properties of @'LAct' x s@.
-instance {-# OVERLAPPING #-} LAct x s => LAct (Identity x) (Identity s) where
-  Identity s <>$ Identity x = Identity (s <>$ x)
-
-instance {-# OVERLAPPING #-} LActSg x s => LActSg (Identity x) (Identity s)
-instance {-# OVERLAPPING #-} LActMn x s => LActMn (Identity x) (Identity s)
-instance {-# OVERLAPPING #-} LActDistrib x s
-  => LActDistrib (Identity x) (Identity s)
-instance {-# OVERLAPPING #-} LActNeutral x s
-  => LActNeutral (Identity x) (Identity s)
-
--- | Preserves action properties of @'RAct' x s@.
-instance RAct x s => RAct x (Identity s) where
-  x $<> Identity s = x $<> s
-  {-# INLINE ($<>) #-}
-
-instance RActSg x s => RActSg x (Identity s)
-instance RActMn x s => RActMn x (Identity s)
-instance RActDistrib x s => RActDistrib x (Identity s)
-instance RActNeutral x s => RActNeutral x (Identity s)
-
--- | Preserves action properties of @'LAct' x s@.
-instance {-# OVERLAPPING #-}  RAct x s => RAct (Identity x) (Identity s) where
-  Identity x $<> Identity s = Identity (x $<> s)
-
-instance {-# OVERLAPPING #-} RActSg x s => RActSg (Identity x) (Identity s)
-instance {-# OVERLAPPING #-} RActMn x s => RActMn (Identity x) (Identity s)
-instance {-# OVERLAPPING #-} RActDistrib x s
-  => RActDistrib (Identity x) (Identity s)
-instance {-# OVERLAPPING #-} RActNeutral x s
-  => RActNeutral (Identity x) (Identity s)
-
-------------------------- Instances for Data.Semigroup -------------------------
-
--- | Preserves action properties of @'LAct' x s@.
-instance LAct x s => RAct x (Dual s) where
-  x $<> Dual s = s <>$ x
-  {-# INLINE ($<>) #-}
-
-instance LActSg x s => RActSg x (Dual s)
-instance LActMn x s => RActMn x (Dual s)
-instance LActDistrib x s => RActDistrib x (Dual s)
-instance LActNeutral x s => RActNeutral x (Dual s)
-
--- | Preserves action properties of @'LAct' x s@.
-instance RAct x s => LAct x (Dual s) where
-  Dual s <>$ x = x $<> s
-  {-# INLINE (<>$) #-}
-
-instance RActSg x s => LActSg x (Dual s)
-instance RActMn x s => LActMn x (Dual s)
-instance RActDistrib x s => LActDistrib x (Dual s)
-instance RActNeutral x s => LActNeutral x (Dual s)
-
--- | Monoid action
-instance LAct x (Endo x) where
-  Endo f <>$ x = f x
-  {-# INLINE (<>$) #-}
-
-instance LActSg x (Endo x)
-instance LActMn x (Endo x)
-
--- | Monoid action
-instance Num x => LAct x (Sum x) where
-  (<>$) s = coerce (s <>)
-  {-# INLINE (<>$) #-}
-
-instance Num x => LActSg x (Sum x)
-instance Num x => LActMn x (Sum x)
-
-
--- | Monoid action
-instance Num x => RAct x (Sum x) where
-  x $<> s = coerce $ coerce x <> s
-  {-# INLINE ($<>) #-}
-
-instance Num x => RActSg x (Sum x)
-instance Num x => RActMn x (Sum x)
-
--- | Monoid action
-instance Num x => LAct x (Product x) where
-  (<>$) s = coerce (s <>)
-  {-# INLINE (<>$) #-}
-
-instance Num x => LActSg x (Product x)
-instance Num x => LActMn x (Product x)
-
--- | Monoid action
-instance Num x => RAct x (Product x) where
-  x $<> s = coerce $ coerce x <> s
-  {-# INLINE ($<>) #-}
-
-instance Num x => RActSg x (Product x)
-instance Num x => RActMn x (Product x)
-
--- | Monoid action
-instance {-# OVERLAPPING #-} Num x => LAct (Sum x) (Sum x) where
-  (<>$) = (<>)
-  {-# INLINE (<>$) #-}
-
-instance {-# OVERLAPPING #-} Num x => LActSg (Sum x) (Sum x)
-instance {-# OVERLAPPING #-} Num x => LActMn (Sum x) (Sum x)
-
--- | Monoid action
-instance {-# OVERLAPPING #-} Num x => RAct (Sum x) (Sum x) where
-  ($<>) = (<>)
-  {-# INLINE ($<>) #-}
-
-instance {-# OVERLAPPING #-} Num x => RActSg (Sum x) (Sum x)
-instance {-# OVERLAPPING #-} Num x => RActMn (Sum x) (Sum x)
-
--- | Monoid action
-instance {-# OVERLAPPING #-}  Num x => LAct (Product x) (Product x) where
-  (<>$) s = coerce (s <>)
-  {-# INLINE (<>$) #-}
-
-instance {-# OVERLAPPING #-} Num x => LActSg (Product x) (Product x)
-instance {-# OVERLAPPING #-} Num x => LActMn (Product x) (Product x)
-
--- | Monoid action
-instance {-# OVERLAPPING #-} Num x => RAct (Product x) (Product x) where
-  ($<>) = (<>)
-  {-# INLINE ($<>) #-}
-
-instance {-# OVERLAPPING #-} Num x => RActSg (Product x) (Product x)
-instance {-# OVERLAPPING #-} Num x => RActMn (Product x) (Product x)
-
--- | Action by morphism of monoids
-instance Num x => LAct (Sum x) (Product x) where
-  (<>$) s = coerce (s <>)
-  {-# INLINE (<>$) #-}
-
-instance Num x => LActSg (Sum x) (Product x)
-instance Num x => LActMn (Sum x) (Product x)
-instance Num x => LActDistrib (Sum x) (Product x)
-instance Num x => LActNeutral (Sum x) (Product x)
-
--- | Action by morphism of monoids
-instance Num x => RAct (Sum x) (Product x) where
-  x $<> s = coerce $ coerce x <> s
-  {-# INLINE ($<>) #-}
-
-instance Num x => RActSg (Sum x) (Product x)
-instance Num x => RActMn (Sum x) (Product x)
-instance Num x => RActDistrib (Sum x) (Product x)
-instance Num x => RActNeutral (Sum x) (Product x)
-
--- | Monoid action
-instance LAct Bool Any where
-  (<>$) s = coerce (s <>)
-  {-# INLINE (<>$) #-}
-
-instance LActSg Bool Any
-instance LActMn Bool Any
-
--- | Monoid action
-instance RAct Bool Any where
-  x $<> s = coerce $ coerce x <> s
-  {-# INLINE ($<>) #-}
-
-instance RActSg Bool Any
-instance RActMn Bool Any
-
--- | Monoid action
-instance LAct Bool All where
-  (<>$) s = coerce (s <>)
-  {-# INLINE (<>$) #-}
-
-instance LActSg Bool All
-instance LActMn Bool All
-
--- | Monoid action
-instance RAct Bool All where
-  x $<> s = coerce $ coerce x <> s
-  {-# INLINE ($<>) #-}
-
-instance RActSg Bool All
-instance RActMn Bool All
-
--- | Semigroup action
-instance LAct x (Sg.First x) where
-  (<>$) s = coerce (s <>)
-  {-# INLINE (<>$) #-}
-
-instance LActSg x (Sg.First x)
-
--- | Semigroup action
-instance RAct x (Sg.Last x) where
-  x $<> s = coerce $ coerce x <> s
-  {-# INLINE ($<>) #-}
-
-instance RActSg x (Sg.Last x)
-
--- | Monoid action
-instance LAct x (Mn.First x) where
-  Mn.First Nothing <>$ x = x
-  Mn.First (Just s) <>$ _ = s
-  {-# INLINE (<>$) #-}
-
-instance LActSg x (Mn.First x)
-instance LActMn x (Mn.First x)
-
--- | Monoid action
-instance RAct x (Mn.Last x) where
-  x $<> Mn.Last Nothing = x
-  _ $<> Mn.Last (Just s) = s
-  {-# INLINE ($<>) #-}
-
-instance RActSg x (Mn.Last x)
-instance RActMn x (Mn.Last x)
+--------------------------------------------------------------------------------+-- |+--+-- Module      :  Data.Act.Act+-- Description :  Actions of sets, semigroups, monoids and groups.+-- Copyright   :  (c) Alice Rixte 2024+-- License     :  BSD 3+-- Maintainer  :  alice.rixte@u-bordeaux.fr+-- Stability   :  unstable+-- Portability :  non-portable (GHC extensions)+--+-- = Usage+--+-- For both @'LAct'@ and @'RAct'@, the acting type is the second parameter. This+-- is a bit counter intuitive when using @'LAct'@, but it allows to use the+-- @DerivingVia@ mechanism to derive instances of @'LAct'@ and @'RAct'@ for+-- newtypes that wrap the acting type. For example, you can use @'ActSelf''@ as+-- follow to derive instances for @'LAct'@ and @'RAct'@ :+--+-- @+-- {-# LANGUAGE DerivingVia #-}+--+-- import Data.Act+-- import Data.Semigroup+--+-- newtype Seconds = Seconds Float+-- newtype Duration = Duration Seconds+--   deriving (Semigroup, Monoid) via (Sum Float)+--+--   deriving ('LAct' Seconds, 'RAct' Seconds) via ('ActSelf'' (Sum Float))+--   -- derives LAct Second  Duration+--+--   deriving ('LAct' [Seconds], RAct [Seconds]) via ('ActMap' ('ActSelf'' (Sum Float)))+--    -- derives LAct [Second] Duration+--+-- newtype Durations = Durations [Duration]+--   deriving ('LAct' Seconds, 'RAct' Seconds) via ('ActFold' [Duration])+--   -- derives LAct Second Durations+-- @+-- >>> Duration (Seconds 1) <>$ (Seconds 2)+-- Seconds 3.0+-- >>> Duration 2 <>$ Seconds 3+-- Seconds 5.0+-- >>> Duration 2 <>$ [Seconds 3, Seconds 4]+-- [Seconds 5.0,Seconds 6.0]+-- >>> [Duration 2, Duration 3] <>$ Seconds 4+-- [Seconds 5.0,Seconds 6.0]+-- >>> Durations [Duration 2, Duration 3] <>$ Seconds 4+-- Seconds 9.0+--+--+--------------------------------------------------------------------------------++module Data.Act.Act+  ( -- * Left actions+    LAct (..)+  , LActSg+  , LActMn+  , LActGp+  , LActDistrib+  , LActSgMorph+  , LActNeutral+  , LActMnMorph+  -- * Right actions+  , RAct (..)+  , RActSg+  , RActMn+  , RActGp+  , RActDistrib+  , RActSgMorph+  , RActNeutral+  , RActMnMorph+  -- * Newtypes for instance derivation+  , ActSelf (..)+  , ActSelf' (..)+  , ActMap (..)+  , ActFold (..)+  , ActFold' (..)+  , ActTrivial (..)+) where++import Data.Semigroup as Sg+import Data.Monoid as Mn+import Data.Group+import Data.Functor.Identity+import Data.Foldable+import Data.Coerce+++-- | A left action of a set @s@ on another set @x@ is a function that maps+-- elements of @s@ to functions on @x@.+--+--+-- There are no additional laws for this class to satisfy.+--+-- One example of useful set action that is not a semigroup action is declared+-- in this file :+--+-- @+--  instance (LAct x s, LAct x t) => LAct x (Either s t) where+--    Left  s <>$ x = s <>$ x+--    Right s <>$ x = s <>$ x+-- @+--+-- This is often useful when dealing with free monoids :+--+-- >>> ActFold [Right (Product (2 :: Int)) , Left (Sum (1 :: Int))] <>$ (2 :: Int)+-- 6+-- >>> (2 :: Int) $<> ActFold [Right (Product (2 :: Int)) , Left (Sum (1 :: Int))]+-- 5+--+-- The order @'LAct'@'s arguments is counter intuitive : even though we write+-- left actions as @s <>$ x@, we declare the constraint as @LAct x s@. The+-- reason for this is to be able to derive instances of @LAct@ while driving the+-- instances by the acting type.+--+-- Instances of @LAct@ are driven by the second parameter (the acting type).+-- Concretely, this means you should never write instances of the form+--+-- @instance LAct SomeType s@+--+-- where @s@ is a type variable.+--++--+class LAct x s where+  {-# MINIMAL lact | (<>$) #-}+  -- | Lifts an element of the set @s@ into a function on the set @x@+  lact :: s -> x -> x+  lact = (<>$)+  {-# INLINE lact #-}+  infixr 5 `lact`++  -- | Infix synonym or @'lact'@+  --+  -- The acting part is on the right of the operator (symbolized by @<>@) and+  -- the actee on the right (symbolized by @$@), hence the notation @<>$@+  (<>$) :: s -> x -> x+  (<>$) = lact+  {-# INLINE (<>$) #-}+  infixr 5 <>$++-- | A left semigroup action+--+-- Instances must satisfy the following law :+--+-- @ (s <> t) <>$ x == s <>$ (t <>$ x) @+--+class (LAct x s, Semigroup s) => LActSg x s++-- | A left monoid action, also called a left /unitary/ action.+--+-- In addition to the laws of @'LActSg'@, instances must satisfy the following+-- law :+--+-- @ 'mempty' <>$ x == x @+--+class (LActSg x s, Monoid s) => LActMn x s++-- | A left action of groups. No additional laws are needed.+--+type LActGp x s = (LActMn x s, Group s)+++-- | A left distributive action+--+-- Instances must satisfy the following law :+--+-- @ s <>$ (x <> y) == (s <>$ x) <> (s <>$ y) @+--+class (LAct x s, Semigroup x) => LActDistrib x s++-- | A left action by morphism of semigroups+--+-- Whenever the constaints @'LActSg' x s@ and @'LActDistrib' x s@ are satisfied,+-- @(s <>$)@ is a morphism of semigroups for any @s@.+--+type LActSgMorph x s =  (LActSg x s, LActDistrib x s)++++-- | A left action on a monoid that preserves its neutral element.+--+-- Instances must satisfy the following law :+--+-- @ s <>$ 'mempty' == 'mempty' @+--+class (LAct x s, Monoid x) => LActNeutral x s++++-- | A left action by morphism of monoids i.e. such that @(s <>$)@ is a morphism of monoids.+--+-- This is equivalent to satisfy the three following properties :+--+-- 1. left action by morphism of semigroups (i.e. @'LActSgMorph' x s@)+-- 2. left monoid action (i.e. @'LActMn' x s@)+-- 3. preseving neutral element (i.e. @'LActNeutral' x s@)+--+type LActMnMorph x s = (LActMn x s, LActSgMorph x s, LActNeutral x s)+++-- | A right action of a set @s@ on another set @x@.+--+-- There are no additional laws for this class to satisfy.+--+class RAct x s where+  {-# MINIMAL ract | ($<>) #-}+  -- | Act on the right of some element of @x@+  ract :: x -> s -> x+  ract = ($<>)+  {-# INLINE ract #-}+  infixl 5 `ract`++  -- | Infix synonym or @'ract'@+  --+  -- The acting part is on the right of the operator (symbolized by @<>@) and+  -- the actee on the left (symbolized by @$@), hence the notation @$<>@.+  --+  ($<>) :: x -> s -> x+  ($<>) = ract+  {-# INLINE ($<>) #-}+  infixl 5 $<>+++-- | A right semigroup action+--+-- Instances must satisfy the following law :+--+-- @ x $<> (s <> t) == (x $<> s) $<> t @+--+class (RAct x s, Semigroup s) => RActSg x s++-- | A right monoid action, also called a right /unitary/ action.+--+-- In addition to the laws of @'RActSg'@, instances must satisfy the following+-- law :+--+-- @ x $<> 'mempty' == x @+--+class (RActSg x s, Monoid s) => RActMn x s++-- | A left action of groups. No additional laws are needed.+--+type RActGp x s = (RActMn x s, Group s)++-- | A right distributive action+--+-- Instances must satisfy the following law :+--+-- @ (x <> y) $<> s == (x $<> s) <> (y $<> s) @+--+class (RAct x s, Semigroup x) => RActDistrib x s+++-- | A right action by morphism of semigroups+--+-- Whenever the constaints @'RActSg' x s@ and @'RActDistrib' x s@ are satisfied,+-- @($<> s)@ is a morphism of semigroups for any @s@.+--+type RActSgMorph x s =  (RActSg x s, RActDistrib x s)+++-- | A right action on a monoid that preserves its neutral element.+--+-- Instances must satisfy the following law :+--+-- @ x $<> mempty == x @+--+class (RAct x s, Monoid x) => RActNeutral x s++-- | A right action by morphism of monoids i.e. such that+--+-- @($<> s)@ is a morphism of monoids+--+type RActMnMorph x s = (RActMn x s, RActSgMorph x s, RActNeutral x s)+++++------------------------------- Newtype actions --------------------------------++-- | A semigroup always acts on itself by translation.+--+-- Notice that whenever there is an instance @LAct x s@ with @x@ different from+-- @s@, this action is lifted to an @ActSelf@ action.+--+-- >>> ActSelf "Hello" <>$ " World !"+-- "Hello World !"+--+newtype ActSelf s = ActSelf {unactSelf :: s}+  deriving stock (Show, Eq)+  deriving newtype (Semigroup, Monoid, Group)++-- | Semigroup action (monoid action when @Monoid s@)+instance Semigroup s => LAct s (ActSelf s) where+  ActSelf s <>$ x = s <> x+  {-# INLINE (<>$) #-}++instance Semigroup s => LActSg s (ActSelf s)+instance Monoid s => LActMn s (ActSelf s)++-- | Semigroup action (monoid action when @Monoid s@)+instance Semigroup s => RAct s (ActSelf s) where+  x $<> ActSelf s = x <> s+  {-# INLINE ($<>) #-}++instance Semigroup s => RActSg s (ActSelf s)+instance Monoid s => RActMn s (ActSelf s)++-- | Actions of @ActSelf'@ behave similarly to those of @'ActSelf'@, but first+-- try to coerce @x@ to @s@ before using the @Semigroup@ instance. If @x@ can be+-- coerced to @s@, then we use the @ActSelf@ action.+--+-- This is meant to be used in conjunction with the @deriving via@ strategy when+-- defining newtype wrappers. Here is a concrete example, where durations act on+-- time. Here, @Seconds@ is not a semigroup and @Duration@ is a group that acts+-- on time via the derived instance @LAct Seconds Duration@.+--+-- @+-- import Data.Semigroup+--+-- newtype Seconds = Seconds Float+--+-- newtype Duration = Duration Seconds+--   deriving ('Semigroup', 'Monoid', 'Group') via ('Sum' Float)+--   deriving ('LAct' Seconds) via ('ActSelf'' ('Sum' Float))+-- @+--+-- >>> Duration 2 <>$ Seconds 3+-- Seconds 5.0+--+newtype ActSelf' x = ActSelf' {unactCoerce :: x}+  deriving stock (Show, Eq)+  deriving newtype (Semigroup, Monoid, Group)++-- | Semigroup action (monoid action when @Monoid s@)+instance {-# OVERLAPPABLE #-} (Semigroup s, Coercible x s)+  => LAct x (ActSelf' s) where+  ActSelf' s <>$ x = coerce $ s <> (coerce x :: s)+  {-# INLINE (<>$) #-}++instance (Coercible x s, Semigroup s) => LActSg x (ActSelf' s)+instance (Coercible x s, Monoid s) => LActMn x (ActSelf' s)++-- | Semigroup action (monoid action when @Monoid s@)+instance {-# OVERLAPPABLE #-} (Semigroup s, Coercible x s)+  => RAct x (ActSelf' s) where+  x $<> ActSelf' s = coerce $ (coerce x :: s) <> s+  {-# INLINE ($<>) #-}++instance (Coercible x s, Semigroup s) => RActSg x (ActSelf' s)+instance (Coercible x s, Monoid s) => RActMn x (ActSelf' s)++-- | The trivial action where any element of @s@ acts as the identity function+-- on @x@+--+-- >>> ActTrivial "Hello !" <>$ "Hi !"+-- " Hi !"++newtype ActTrivial x = ActTrivial  {unactId :: x}+  deriving stock (Show, Eq)+  deriving newtype (Semigroup, Monoid, Group)++-- | Action by morphism of monoids when @'Monoid' s@ and @'Monoid' x@+instance LAct x (ActTrivial s) where+  (<>$) _ = id+  {-# INLINE (<>$) #-}++instance Semigroup s => LActSg x (ActTrivial s)+instance Monoid s => LActMn x (ActTrivial s)+instance Semigroup x => LActDistrib x (ActTrivial s)+instance Monoid x => LActNeutral x (ActTrivial s)++-- | Action by morphism of monoids when @'Monoid' s@ and @'Monoid' x@+instance RAct x (ActTrivial s) where+  x $<> _ = x+  {-# INLINE ($<>) #-}++instance Semigroup s => RActSg x (ActTrivial s)+instance Monoid s => RActMn x (ActTrivial s)+instance Semigroup x => RActDistrib x (ActTrivial s)+instance Monoid x => RActNeutral x (ActTrivial s)++-- | An action on any functor that uses the @fmap@ function. For example :+--+-- >>> ActMap (ActSelf "Hello") <>$ [" World !", " !"]+-- ["Hello World !","Hello !"]+--+newtype ActMap s = ActMap {unactMap :: s}+  deriving stock (Show, Eq)+  deriving newtype (Semigroup, Monoid, Group)++-- | Preserves the semigroup (resp. monoid) property of @'LAct' x s@, but+-- __not__ the morphism properties, which depend on potential @'Semigroup'@+-- (resp. @'Monoid'@) instances of @f x@+instance (LAct x s, Functor f) => LAct (f x) (ActMap s) where+  ActMap s <>$ x = fmap (s <>$) x+  {-# INLINE (<>$) #-}++instance (LActSg x s, Functor f) => LActSg (f x) (ActMap s)+instance (LActMn x s, Functor f) => LActMn (f x) (ActMap s)+instance LAct x s => LActDistrib [x] (ActMap s)+instance LAct x s => LActNeutral [x] (ActMap s)+++-- | Preserves the semigroup (resp. monoid) property of @'LAct' x s@, but+-- __not__ the morphism properties, which depend on potential @'Semigroup'@+-- (resp. @'Monoid'@) instances of @f x@. When $f = []@, this is an action by morphism of monoids.+instance (RAct x s, Functor f) => RAct (f x) (ActMap s) where+  x $<> ActMap s = fmap ($<> s) x+  {-# INLINE ($<>) #-}++instance (RActSg x s, Functor f) => RActSg (f x) (ActMap s)+instance (RActMn x s, Functor f) => RActMn (f x) (ActMap s)+instance RAct x s => RActDistrib [x] (ActMap s)+instance RAct x s => RActNeutral [x] (ActMap s)++-- | Lifting an a container as an action using @'foldr'@ (for /left/ actions) or+-- @'foldl'@ (for /right/ actions). For a strict version, use @'ActFold''@.+--+-- A left action @(<>$)@ can be seen as an operator for the @'foldr'@ function,+-- and a allowing to lift any action to some @'Foldable'@ container.+--+-- >> ActFold [Sum (1 :: Int), Sum 2, Sum 3] <>$ (4 :: Int)+-- >  10+--+newtype ActFold s = ActFold {unactFold :: s}+  deriving stock (Show, Eq)+  deriving newtype (Semigroup, Monoid, Group)++-- | When used with lists @[]@, this is a monoid action+instance (Foldable f, LAct x s) => LAct x (ActFold (f s)) where+  ActFold f <>$ x = foldr (<>$) x f+  {-# INLINE (<>$) #-}++instance LAct x s => LActSg x (ActFold [s])++-- | When used with lists @[]@, this is a monoid action+instance (Foldable f, RAct x s) => RAct x (ActFold (f s)) where+  x $<> ActFold f = foldl ($<>) x f+  {-# INLINE ($<>) #-}++-- | Lifting an a container as an action using @'fold'r'@ (for /left/ actions)+-- or @'foldl''@ (for /right/ actions). For a lazy version, use @'ActFold'@.+--+-- A left action @(<>$)@ can be seen as an operator for the @'foldr'@ function,+-- and a allowing to lift any action to some @'Foldable'@ container.+--+-- >>> ActFold' [Sum (1 :: Int), Sum 2, Sum 3] <>$ (4 :: Int)+-- 10+--+newtype ActFold' s = ActFold' {unactFold' :: s}+  deriving stock (Show, Eq)+  deriving newtype (Semigroup, Monoid, Group)++-- | When used with lists @[]@, this is a monoid action+instance (Foldable f, LAct x s) => LAct x (ActFold' (f s)) where+  ActFold' f <>$ x = foldr' (<>$) x f+  {-# INLINE (<>$) #-}++instance LAct x s => LActSg x (ActFold' [s])++-- | When used with lists @[]@, this is a monoid action+instance (Foldable f, RAct x s) => RAct x (ActFold' (f s)) where+  x $<> ActFold' f = foldl' ($<>) x f+  {-# INLINE ($<>) #-}+++---------------------------------- Instances -----------------------------------++-- | Action by morphism of monoids+instance LAct x () where+  () <>$ x = x+  {-# INLINE (<>$) #-}++instance LActSg x ()+instance LActMn x ()+instance Semigroup x => LActDistrib x ()+instance Monoid x => LActNeutral x ()++-- | Monoid action+instance RAct x () where+  x $<> () = x+  {-# INLINE ($<>) #-}++instance RActSg x ()+instance RActMn x ()+instance Semigroup x => RActDistrib x ()+instance Monoid x => RActNeutral x ()++-- |  Action by morphism of semigroups (resp. monoids) when @'Semigroup' s@+-- (resp. @'Monoid' s@)+instance {-# INCOHERENT #-} LAct () s where+  _ <>$ () = ()+  {-# INLINE (<>$) #-}++instance {-# INCOHERENT #-} Semigroup s =>LActSg () s+instance {-# INCOHERENT #-} Monoid s =>  LActMn () s+instance {-# INCOHERENT #-} LActDistrib () s+instance {-# INCOHERENT #-} LActNeutral () s++-- |  Action by morphism of semigroups (resp. monoids) when @'Semigroup' s@+-- (resp. @'Monoid' s@)+instance {-# INCOHERENT #-} RAct () s where+  () $<> _ = ()+  {-# INLINE ($<>) #-}++instance {-# INCOHERENT #-} Semigroup s => RActSg () s+instance {-# INCOHERENT #-} Monoid s => RActMn () s+instance {-# INCOHERENT #-} RActDistrib () s+instance {-# INCOHERENT #-} RActNeutral () s++-- | Monoid action when @'LAct' x s@ is a semigroup action.+instance LAct x s => LAct x (Maybe s) where+  Nothing <>$ x = x+  Just s <>$ x = s <>$ x++instance LActSg x s => LActSg x (Maybe s)+instance LActSg x s => LActMn x (Maybe s)++-- | Monoid action when @'LAct' x s@ is a semigroup action.+instance RAct x s => RAct x (Maybe s) where+  x $<> Nothing = x+  x $<> Just s = x $<> s++instance RActSg x s => RActSg x (Maybe s)+instance RActSg x s => RActMn x (Maybe s)++-- | Same action propety as the weaker properties of @('LAct' x1 s1, 'LAct' x2+-- s2)@+instance (LAct x1 s1, LAct x2 s2) => LAct (x1, x2) (s1, s2) where+  (s1, s2) <>$ (x1, x2) = (s1 <>$ x1, s2 <>$ x2)++instance (LActSg x1 s1, LActSg x2 s2) => LActSg (x1, x2) (s1, s2)+instance (LActMn x1 s1, LActMn x2 s2) => LActMn (x1, x2) (s1, s2)+instance (LActDistrib x1 s1, LActDistrib x2 s2) => LActDistrib (x1, x2) (s1, s2)+instance (LActNeutral x1 s1, LActNeutral x2 s2) => LActNeutral (x1, x2) (s1, s2)++-- | Same action propety as the weaker properties of @('LAct' x1 s1, 'LAct' x2+-- s2)@+instance (RAct x1 s1, RAct x2 s2) => RAct (x1, x2) (s1, s2) where+  (x1, x2) $<> (s1, s2) = (x1 $<> s1, x2 $<> s2)++instance (RActSg x1 s1, RActSg x2 s2) => RActSg (x1, x2) (s1, s2)+instance (RActMn x1 s1, RActMn x2 s2) => RActMn (x1, x2) (s1, s2)+instance (RActDistrib x1 s1, RActDistrib x2 s2) => RActDistrib (x1, x2) (s1, s2)+instance (RActNeutral x1 s1, RActNeutral x2 s2) => RActNeutral (x1, x2) (s1, s2)++-- | No additionnal properties. In particular this is _not_ a semigroup action.+instance (LAct x s, LAct x t) => LAct x (Either s t) where+  (Left  s) <>$ x = s <>$ x+  (Right s) <>$ x = s <>$ x+  {-# INLINE (<>$) #-}++-- | No additionnal properties. In particular this is _not_ a semigroup action.+instance (RAct x s, RAct x t) => RAct x (Either s t) where+  x $<> (Left  s) = x $<> s+  x $<> (Right s) = x $<> s+  {-# INLINE ($<>) #-}++-------------------- Instances for base library functors ---------------------++-- | Preserves action properties of @'LAct' x s@.+instance LAct x s => LAct x (Identity s) where+  Identity s <>$ x = s <>$ x+  {-# INLINE (<>$) #-}++instance LActSg x s => LActSg x (Identity s)+instance LActMn x s => LActMn x (Identity s)+instance LActDistrib x s => LActDistrib x (Identity s)+instance LActNeutral x s => LActNeutral x (Identity s)+++-- | Preserves action properties of @'LAct' x s@.+instance {-# OVERLAPPING #-} LAct x s => LAct (Identity x) (Identity s) where+  Identity s <>$ Identity x = Identity (s <>$ x)++instance {-# OVERLAPPING #-} LActSg x s => LActSg (Identity x) (Identity s)+instance {-# OVERLAPPING #-} LActMn x s => LActMn (Identity x) (Identity s)+instance {-# OVERLAPPING #-} LActDistrib x s+  => LActDistrib (Identity x) (Identity s)+instance {-# OVERLAPPING #-} LActNeutral x s+  => LActNeutral (Identity x) (Identity s)++-- | Preserves action properties of @'RAct' x s@.+instance RAct x s => RAct x (Identity s) where+  x $<> Identity s = x $<> s+  {-# INLINE ($<>) #-}++instance RActSg x s => RActSg x (Identity s)+instance RActMn x s => RActMn x (Identity s)+instance RActDistrib x s => RActDistrib x (Identity s)+instance RActNeutral x s => RActNeutral x (Identity s)++-- | Preserves action properties of @'LAct' x s@.+instance {-# OVERLAPPING #-}  RAct x s => RAct (Identity x) (Identity s) where+  Identity x $<> Identity s = Identity (x $<> s)++instance {-# OVERLAPPING #-} RActSg x s => RActSg (Identity x) (Identity s)+instance {-# OVERLAPPING #-} RActMn x s => RActMn (Identity x) (Identity s)+instance {-# OVERLAPPING #-} RActDistrib x s+  => RActDistrib (Identity x) (Identity s)+instance {-# OVERLAPPING #-} RActNeutral x s+  => RActNeutral (Identity x) (Identity s)++------------------------- Instances for Data.Semigroup -------------------------++-- | Preserves action properties of @'LAct' x s@.+instance LAct x s => RAct x (Dual s) where+  x $<> Dual s = s <>$ x+  {-# INLINE ($<>) #-}++instance LActSg x s => RActSg x (Dual s)+instance LActMn x s => RActMn x (Dual s)+instance LActDistrib x s => RActDistrib x (Dual s)+instance LActNeutral x s => RActNeutral x (Dual s)++-- | Preserves action properties of @'LAct' x s@.+instance RAct x s => LAct x (Dual s) where+  Dual s <>$ x = x $<> s+  {-# INLINE (<>$) #-}++instance RActSg x s => LActSg x (Dual s)+instance RActMn x s => LActMn x (Dual s)+instance RActDistrib x s => LActDistrib x (Dual s)+instance RActNeutral x s => LActNeutral x (Dual s)++-- | Monoid action+instance LAct x (Endo x) where+  Endo f <>$ x = f x+  {-# INLINE (<>$) #-}++instance LActSg x (Endo x)+instance LActMn x (Endo x)++-- | Monoid action+instance Num x => LAct x (Sum x) where+  (<>$) s = coerce (s <>)+  {-# INLINE (<>$) #-}++instance Num x => LActSg x (Sum x)+instance Num x => LActMn x (Sum x)+++-- | Monoid action+instance Num x => RAct x (Sum x) where+  x $<> s = coerce $ coerce x <> s+  {-# INLINE ($<>) #-}++instance Num x => RActSg x (Sum x)+instance Num x => RActMn x (Sum x)++-- | Monoid action+instance Num x => LAct x (Product x) where+  (<>$) s = coerce (s <>)+  {-# INLINE (<>$) #-}++instance Num x => LActSg x (Product x)+instance Num x => LActMn x (Product x)++-- | Monoid action+instance Num x => RAct x (Product x) where+  x $<> s = coerce $ coerce x <> s+  {-# INLINE ($<>) #-}++instance Num x => RActSg x (Product x)+instance Num x => RActMn x (Product x)++-- | Monoid action+instance {-# OVERLAPPING #-} Num x => LAct (Sum x) (Sum x) where+  (<>$) = (<>)+  {-# INLINE (<>$) #-}++instance {-# OVERLAPPING #-} Num x => LActSg (Sum x) (Sum x)+instance {-# OVERLAPPING #-} Num x => LActMn (Sum x) (Sum x)++-- | Monoid action+instance {-# OVERLAPPING #-} Num x => RAct (Sum x) (Sum x) where+  ($<>) = (<>)+  {-# INLINE ($<>) #-}++instance {-# OVERLAPPING #-} Num x => RActSg (Sum x) (Sum x)+instance {-# OVERLAPPING #-} Num x => RActMn (Sum x) (Sum x)++-- | Monoid action+instance {-# OVERLAPPING #-}  Num x => LAct (Product x) (Product x) where+  (<>$) s = coerce (s <>)+  {-# INLINE (<>$) #-}++instance {-# OVERLAPPING #-} Num x => LActSg (Product x) (Product x)+instance {-# OVERLAPPING #-} Num x => LActMn (Product x) (Product x)++-- | Monoid action+instance {-# OVERLAPPING #-} Num x => RAct (Product x) (Product x) where+  ($<>) = (<>)+  {-# INLINE ($<>) #-}++instance {-# OVERLAPPING #-} Num x => RActSg (Product x) (Product x)+instance {-# OVERLAPPING #-} Num x => RActMn (Product x) (Product x)++-- | Action by morphism of monoids+instance Num x => LAct (Sum x) (Product x) where+  (<>$) s = coerce (s <>)+  {-# INLINE (<>$) #-}++instance Num x => LActSg (Sum x) (Product x)+instance Num x => LActMn (Sum x) (Product x)+instance Num x => LActDistrib (Sum x) (Product x)+instance Num x => LActNeutral (Sum x) (Product x)++-- | Action by morphism of monoids+instance Num x => RAct (Sum x) (Product x) where+  x $<> s = coerce $ coerce x <> s+  {-# INLINE ($<>) #-}++instance Num x => RActSg (Sum x) (Product x)+instance Num x => RActMn (Sum x) (Product x)+instance Num x => RActDistrib (Sum x) (Product x)+instance Num x => RActNeutral (Sum x) (Product x)++-- | Monoid action+instance LAct Bool Any where+  (<>$) s = coerce (s <>)+  {-# INLINE (<>$) #-}++instance LActSg Bool Any+instance LActMn Bool Any++-- | Monoid action+instance RAct Bool Any where+  x $<> s = coerce $ coerce x <> s+  {-# INLINE ($<>) #-}++instance RActSg Bool Any+instance RActMn Bool Any++-- | Monoid action+instance LAct Bool All where+  (<>$) s = coerce (s <>)+  {-# INLINE (<>$) #-}++instance LActSg Bool All+instance LActMn Bool All++-- | Monoid action+instance RAct Bool All where+  x $<> s = coerce $ coerce x <> s+  {-# INLINE ($<>) #-}++instance RActSg Bool All+instance RActMn Bool All++-- | Semigroup action+instance LAct x (Sg.First x) where+  (<>$) s = coerce (s <>)+  {-# INLINE (<>$) #-}++instance LActSg x (Sg.First x)++-- | Semigroup action+instance RAct x (Sg.Last x) where+  x $<> s = coerce $ coerce x <> s+  {-# INLINE ($<>) #-}++instance RActSg x (Sg.Last x)++-- | Monoid action+instance LAct x (Mn.First x) where+  Mn.First Nothing <>$ x = x+  Mn.First (Just s) <>$ _ = s+  {-# INLINE (<>$) #-}++instance LActSg x (Mn.First x)+instance LActMn x (Mn.First x)++-- | Monoid action+instance RAct x (Mn.Last x) where+  x $<> Mn.Last Nothing = x+  _ $<> Mn.Last (Just s) = s+  {-# INLINE ($<>) #-}++instance RActSg x (Mn.Last x)+instance RActMn x (Mn.Last x)

@@ -1,494 +1,599 @@-{-# LANGUAGE AllowAmbiguousTypes        #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE DefaultSignatures          #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DerivingStrategies         #-}
-
---------------------------------------------------------------------------------
--- |
---
--- Module      :  Data.Act.Cyclic
--- Description :  Cyclic actions and actions generated by a subset of generators.
--- Copyright   :  (c) Alice Rixte 2024
--- License     :  BSD 3
--- Maintainer  :  alice.rixte@u-bordeaux.fr
--- Stability   :  unstable
--- Portability :  non-portable (GHC extensions)
---
--- = Presentation
---
--- === Cyclic actions
---
--- A cyclic action (see @'LActCyclic'@ or @'RActCyclic'@) is an action such that
--- every element of the actee set can be obtained by acting on some generator,
--- which we call here the /origin/ of the actee set.
---
--- For example, @'Sum' Integer@ acts cyclically on @'Integer'@ because for every
--- @n :: Integer@, we have @Sum n <>$ O == n@. In this example, @0@ is a
--- generator of the action @'LAct' Int (Sum Int)@ and in this library, we will
--- call it @'lorigin'@.
---
--- This gives us a way to lift any actee element into an action element. In this
--- library,  we call that lifting @'lshift'@  (resp. @'rshift'@). In the
--- previous example we get @'lshift' = Sum@.
---
--- === Actions generated by a subset of generators
---
--- In a more general setting, this library also provides @'LActGen'@ and
--- @'RActGen'@. In theory, they should be superclasses of @'LActCyclic'@ and
--- @'RActCyclic'@. In practice it is annoying to need @'Eq'@ instances for
--- defining @'lgenerators'@ and @'rgenerators'@. Please open an issue if you
--- actually need this.
---
---
--- = Usage
---
--- >>> {-# LANGUAGE TypeApplications #-}
--- >>> import Data.Act.Cyclic
--- >>> import Data.Semigroup
--- >>> lorigin @(Sum Int) :: Int
--- 0
--- >>> lshift (4 :: Int) :: Sum Int
--- Sum {getSum = 4}
---
--- = Formal algebraic definitions
---
--- In algebraic terms, a subset @u@ of the set @x@ is a /generating set/ of the
--- action @LAct x s@ if for every @x :: x@, there exists a pair @(u,s) :: (u,s)@
--- such that @s <>$ u = x@. When the set @u@ is finite, the action @LAct x s@ is
--- said to be finitely generated. When the set @u@ is a singleton, the action is
--- said to be /cyclic/.
---
--- When the previous decomposition is unique, the action is said to be /free/.
--- If it is both free and cyclic, it is /1-free/.
---
--- (See /Monoids, Acts and Categories/ by Mati
--- Kilp, Ulrich Knauer, Alexander V. Mikhalev, definition 1.5.1, p.63.)
---
--- Remark : Freeness could be represented with classes @LActFree@ and
--- @LActOneFree@ that have no methods. Feel free to open an issue if you need
--- them.
---------------------------------------------------------------------------------
-
-
-module Data.Act.Cyclic
-  ( -- * Cyclic actions
-    LActCyclic (..)
-  , lorigin
-  , RActCyclic (..)
-  , rorigin
-   -- * Action generated by a subset of generators
-  , LActGen (..)
-  , lgenerators
-  , lgeneratorsList
-  , lorigins
-  , RActGen (..)
-  , rgenerators
-  , rgeneratorsList
-  , rorigins
-  )
-  where
-
-import Data.Bifunctor
-import Data.Functor.Identity
-import Data.Coerce
-import Data.Semigroup as Sg
-import Data.Monoid as Mn
-
-import Data.Default
-
-
-
-import Data.Act.Act
-
-
--- | A left action generated by a single generator.
---
--- Instances must satisfy the following law :
---
--- * 'lshift' x @ <>$ 'lorigin' == x@
---
--- In other words, 'lorigin' is a generator of the action @LAct x s@.
---
-class LAct x s => LActCyclic x s where
-  -- | The only generator of the action @LAct x s@.
-  --
-  -- >>> lorigin' @Int @(Sum Int)
-  -- 0
-  --
-  -- To avoid having to use the redundant first type aplication, use
-  -- @'lorigin'@.
-  --
-  lorigin' :: x
-
-  --- | Shifts an element of @x@ into an action @lshift x@ such that
-  -- @lshift x <>$ lorigin == x@.
-  --
-  lshift :: x -> s
-
--- | A version of @'lorigin''@ such that the first type application is @s@.
---
--- >>> lorigin @(Sum Int) :: Int
--- 0
---
-lorigin :: forall s x. LActCyclic x s => x
-lorigin = lorigin' @x @s
-{-# INLINE lorigin #-}
-
-
--- | A right action generated by a single generator.
---
--- Instances must satisfy the following law :
---
--- * 'rorigin' @ $<> 'rshift' x == x@
---
--- In other words, 'rorigin' is a generator of the action @RAct x s@.
---
-class RAct x s => RActCyclic x s where
-  -- | The only generator of the action @RAct x s@.
-  --
-  -- >>> rorigin' @Int @(Sum Int) :: Int
-  -- 0
-  --
-  -- To avoid having to use the redundant first type aplication, use
-  -- @'rorigin'@.
-  rorigin' :: x
-
-  -- | Shifts an element of @x@ into an action @rshift x@ such that
-  -- @rshift x $<> rorigin == x@.
-  rshift :: x -> s
-
--- | A version of @'rorigin''@ such that the first type application is @s@.
---
--- >>> rorigin @(Sum Int) :: Int
--- 0
---
-rorigin :: forall s x. RActCyclic x s => x
-rorigin = rorigin' @x @s
-{-# INLINE rorigin #-}
-
-
-
-
--- | A left action generated by a subset of generators @'lgenerators'@.
---
--- Intuitively, by acting repeteadly on generators with actions
--- of @s@, we can reach any element of @x@.
---
--- Since the generating subset of @x@ maybe infinite, we give two alternative
--- ways to define it : one using a characteristic function @'lgenerators'@ and
--- the other using a list @'lgeneratorsList'@.
---
--- All the above is summarized by the following law that all instances must
--- satisfy :
---
--- 1. 'snd' @('lshiftFromGen' x) <>$ 'fst' ('lshiftFromGen' x) == x@
--- 2. 'lgenerators'@  ('fst' $ 'lshiftFromGen' x) == True@
--- 3. 'lgenerators' @ x == x `'elem'` 'lgeneratorsList' proxy@
---
-class LAct x s => LActGen x s where
-  -- | The set of origins of the action @'LAct' x s@.
-  --
-  -- This is a subset of @x@, represented as its characteristic function,
-  -- meaning the function that returns @True@ for all elements of @x@ that are
-  -- origins of the action and @False@ otherwise.
-  --
-  -- To use @'lgenerators'@, you need TypeApplications:
-  --
-  -- >>> lgenerators' @Int @(Sum Int) 4
-  -- False
-  --
-  -- >>> lgenerators' @Int @(Sum Int) 0
-  -- True
-  --
-  -- To avoid having to use the redundant first type aplication, use
-  -- @'lgenerators'@.
-  lgenerators' :: x -> Bool
-  default lgenerators' :: Eq x => x -> Bool
-  lgenerators' x = x `elem` lgeneratorsList' @x @s
-
-  -- | The set of origins of the action @LAct x s@ seen as a list.
-  --
-  -- You can let this function undefined if the set of origins cannot be
-  -- represented as a list.
-  --
-  -- >>> lgeneratorsList' @Int @(Sum Int)
-  -- [0]
-  --
-  -- To avoid having to use the redundant first type aplication, use
-  -- @'lgeneratorsList'@.
-  --
-  lgeneratorsList' :: [x]
-  default lgeneratorsList' :: LActCyclic x s => [x]
-  lgeneratorsList' = [lorigin @s]
-
-  -- | Returns a point's associated genrator @u@ along with an action @s@ such
-  -- that @s <>$ u == x@.
-  lshiftFromGen:: x -> (x,s)
-  default lshiftFromGen :: LActCyclic x s => x -> (x,s)
-  lshiftFromGen x = (lorigin @s, lshift x)
-
--- | A version of @'lgenerators''@ such that the first type application is @s@.
---
--- >>> lgenerators @(Sum Int) (4 :: Int)
--- False
---
--- >>> lgenerators @(Sum Int) (0 :: Int)
--- True
---
-lgenerators :: forall s x. LActGen x s => x -> Bool
-lgenerators = lgenerators' @x @s
-{-# INLINE lgenerators #-}
-
--- | A version of @'lgeneratorsList''@ such that the first type application is
--- @s@.
---
--- >>> lgeneratorsList @(Sum Int) :: [Int]
--- [0]
---
-lgeneratorsList :: forall s x. LActGen x s => [x]
-lgeneratorsList = lgeneratorsList' @x @s
-{-# INLINE lgeneratorsList #-}
-
--- | An alias for @'lgeneratorsList'@.
-lorigins :: forall s x. LActGen x s => [x]
-lorigins = lgeneratorsList @s
-{-# INLINE lorigins #-}
-
-
-
-------------------------------------------------------------------------------
-
--- | A right action generated by a subset of generators @'lgenerators'@.
---
--- Intuitively, by acting repeteadly on generators with actions
--- of @s@, we can reach any element of @x@.
---
---
--- Since the generating subset of @x@ maybe infinite, we give two alternative
--- ways to define it : one using a characteristic function @'rgenerators'@ and
--- the other using a list @'rgeneratorsList'@.
---
--- All the above is summarized by the following law that all instances must
--- satisfy :
---
--- 1. 'rgenerators'@  ('fst' $ 'rshiftFromGen' x) == True@
--- 2. 'fst' ('rshiftFromGen' x) $<> 'snd' @('rshiftFromGen' x) == x@
--- 3. 'rgenerators' @x == x `'elem'` 'rgeneratorsList' x@
---
-class RAct x s => RActGen x s where
-  -- | The set of origins of the action @'RAct' x s@.
-  --
-  -- This is a subset of @x@, represented as its characteristic function,
-  -- meaning the function that returns @True@ for all elements of @x@ that are
-  -- origins of the action and @False@ otherwise.
-  --
-  -- To use @'rgenerators'@, you need TypeApplications:
-  --
-  -- >>> rgenerators' @(Sum Int) (4 :: Int)
-  -- False
-  --
-  -- >>> rgenerators' @(Sum Int) (0 :: Int)
-  -- True
-  --
-  -- To avoid having to use the redundant first type aplication, use
-  -- @'rgenerators'@.
-  rgenerators' :: x -> Bool
-  default rgenerators' :: Eq x => x -> Bool
-  rgenerators' x = x `elem` rgeneratorsList' @x @s
-  {-# INLINE rgenerators' #-}
-
-  -- | The set of origins of the action @RAct x s@ seen as a list.
-  --
-  -- You can let this function undefined if the set of origins cannot be
-  -- represented as a list.
-  --
-  -- >>> rgeneratorsList' @(Sum Int) :: [Int]
-  -- [0]
-  --
-  rgeneratorsList' :: [x]
-  default rgeneratorsList' :: RActCyclic x s => [x]
-  rgeneratorsList' = [rorigin @s]
-  {-# INLINE rgeneratorsList' #-}
-
-  -- | Returns a point's associated generator @u@ along with an action @s@ such
-  -- that @u $<> s == x@.
-  rshiftFromGen :: x -> (x,s)
-  default rshiftFromGen :: RActCyclic x s => x -> (x,s)
-  rshiftFromGen x = (rorigin @s, rshift x)
-  {-# INLINE rshiftFromGen #-}
-
--- | A version of @'rgenerators''@ such that the first type application is @s@.
---
--- >>> rgenerators @(Sum Int) (4 :: Int)
--- False
---
--- >>> rgenerators @(Sum Int) (0 :: Int)
--- True
---
-rgenerators :: forall s x. RActGen x s => x -> Bool
-rgenerators = rgenerators' @x @s
-{-# INLINE rgenerators #-}
-
--- | A version of @'rgeneratorsList''@ such that the first type application is
--- @s@.
---
--- >>> rgeneratorsList @(Sum Int) :: [Int]
--- [0]
---
-rgeneratorsList :: forall s x. RActGen x s => [x]
-rgeneratorsList = rgeneratorsList' @x @s
-{-# INLINE rgeneratorsList #-}
-
--- | An alias for @'rgeneratorsList'@.
---
-rorigins :: forall s x. RActGen x s => [x]
-rorigins = rgeneratorsList @s
-{-# INLINE rorigins #-}
-
-
-
----------------------------------- Instances -----------------------------------
-
--- Identity --
-
-instance LActGen x s => LActGen (Identity x) (Identity s) where
-  lgenerators' (Identity x) = lgenerators @s x
-  {-# INLINE lgenerators' #-}
-  lgeneratorsList' = Identity <$> lgeneratorsList @s
-  {-# INLINE lgeneratorsList' #-}
-  lshiftFromGen (Identity x) = bimap Identity Identity $ lshiftFromGen x
-  {-# INLINE lshiftFromGen #-}
-
-instance LActCyclic x s => LActCyclic (Identity x) (Identity s) where
-  lorigin' = Identity (lorigin @s)
-  {-# INLINE lorigin' #-}
-  lshift (Identity x) = Identity (lshift x)
-  {-# INLINE lshift #-}
-
-instance RActGen x s => RActGen (Identity x) (Identity s) where
-  rgenerators' (Identity x) = rgenerators @s x
-  {-# INLINE rgenerators' #-}
-  rgeneratorsList' = Identity <$> rgeneratorsList @s
-  {-# INLINE rgeneratorsList' #-}
-  rshiftFromGen (Identity x) = bimap Identity Identity $ rshiftFromGen x
-  {-# INLINE rshiftFromGen #-}
-
-instance RActCyclic x s => RActCyclic (Identity x) (Identity s) where
-  rorigin' = Identity (rorigin @s)
-  {-# INLINE rorigin' #-}
-  rshift (Identity x) = Identity (rshift x)
-  {-# INLINE rshift #-}
-
--- ActSelf --
-
-instance (Eq s, Monoid s) => LActGen s (ActSelf s)
-
-instance Monoid s => LActCyclic s (ActSelf s) where
-  lorigin' = mempty
-  {-# INLINE lorigin' #-}
-  lshift = ActSelf
-  {-# INLINE lshift #-}
-
-instance (Eq s, Monoid s) => RActGen s (ActSelf s)
-
-instance Monoid s => RActCyclic s (ActSelf s) where
-  rorigin' = mempty
-  {-# INLINE rorigin' #-}
-  rshift = ActSelf
-  {-# INLINE rshift #-}
-
-
--- ActSelf' --
-
-instance (Eq x, Coercible x s, Monoid s) => LActGen x (ActSelf' s)
-
-instance (Coercible x s, Monoid s) => LActCyclic x (ActSelf' s) where
-  lorigin' = coerce (mempty :: s)
-  {-# INLINE lorigin' #-}
-  lshift = coerce
-  {-# INLINE lshift #-}
-
-instance (Eq x, Coercible x s, Monoid s) => RActGen x (ActSelf' s)
-
-instance (Coercible x s, Monoid s) => RActCyclic x (ActSelf' s) where
-  rorigin' = coerce (mempty :: s)
-  {-# INLINE rorigin' #-}
-  rshift = coerce
-  {-# INLINE rshift #-}
-
--- Sum --
-
-instance (Eq x, Num x) => LActGen x (Sum x)
-
-instance Num x => LActCyclic x (Sum x) where
-  lorigin' = 0
-  {-# INLINE lorigin' #-}
-  lshift = Sum
-  {-# INLINE lshift #-}
-
-instance (Eq x, Num x) => RActGen x (Sum x)
-
-instance Num x => RActCyclic x (Sum x) where
-  rorigin' = 0
-  {-# INLINE rorigin' #-}
-  rshift = Sum
-  {-# INLINE rshift #-}
-
--- Product --
-
-instance (Eq x, Num x) => LActGen x (Product x)
-
-instance Num x => LActCyclic x (Product x) where
-  lorigin' = 1
-  {-# INLINE lorigin' #-}
-  lshift = Product
-  {-# INLINE lshift #-}
-
-instance (Eq x, Num x) => RActGen x (Product x)
-
-instance Num x => RActCyclic x (Product x) where
-  rorigin' = 1
-  {-# INLINE rorigin' #-}
-  rshift = Product
-  {-# INLINE rshift #-}
-
--- Product on Sum --
-
-instance (Eq x, Num x) => LActGen (Sum x) (Product x)
-
-instance Num x => LActCyclic (Sum x) (Product x) where
-  lorigin' = 1
-  {-# INLINE lorigin' #-}
-  lshift = coerce
-  {-# INLINE lshift #-}
-
-instance (Eq x, Num x) => RActGen (Sum x) (Product x)
-
-instance Num x => RActCyclic (Sum x) (Product x) where
-  rorigin' = 1
-  {-# INLINE rorigin' #-}
-  rshift = coerce
-  {-# INLINE rshift #-}
-
--- First --
-
-instance Default x => LActCyclic x (Sg.First x) where
-  lorigin' = def
-  lshift = Sg.First
-
-instance Default x => LActCyclic x (Mn.First x) where
-  lorigin' = def
-  lshift = Mn.First . Just
-
-instance Default x => RActCyclic x (Sg.Last x) where
-  rorigin' = def
-  rshift = Sg.Last
-
-instance Default x => RActCyclic x (Mn.Last x) where
-  rorigin' = def
-  rshift = Mn.Last . Just
-
+{-# LANGUAGE AllowAmbiguousTypes        #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE DerivingVia                #-}++--------------------------------------------------------------------------------+-- |+--+-- Module      :  Data.Act.Cyclic+-- Description :  Cyclic actions and actions generated by a subset of generators.+-- Copyright   :  (c) Alice Rixte 2024+-- License     :  BSD 3+-- Maintainer  :  alice.rixte@u-bordeaux.fr+-- Stability   :  unstable+-- Portability :  non-portable (GHC extensions)+--+-- = Presentation+--+-- === Cyclic actions+--+-- A cyclic action (see @'LActCyclic'@ or @'RActCyclic'@) is an action such that+-- every element of the actee set can be obtained by acting on some generator,+-- which we call here the /origin/ of the actee set.+--+-- For example, @'Sum' Integer@ acts cyclically on @'Integer'@ because for every+-- @n :: Integer@, we have @Sum n <>$ O == n@. In this example, @0@ is a+-- generator of the action @'LAct' Int (Sum Int)@ and in this library, we will+-- call it @'lorigin'@.+--+-- This gives us a way to lift any actee element into an action element. In this+-- library,  we call that lifting @'lshift'@  (resp. @'rshift'@). In the+-- previous example we get @'lshift' = Sum@.+--+-- === Actions generated by a subset of generators+--+-- In a more general setting, this library also provides @'LActGen'@ and+-- @'RActGen'@. In theory, they should be superclasses of @'LActCyclic'@ and+-- @'RActCyclic'@. In practice it is annoying to need @'Eq'@ instances for+-- defining @'lgenerators'@ and @'rgenerators'@. Please open an issue if you+-- actually need this.+--+--+-- = Usage+--+-- >>> {-# LANGUAGE TypeApplications #-}+-- >>> import Data.Act.Cyclic+-- >>> import Data.Semigroup+-- >>> lorigin @(Sum Int) :: Int+-- 0+-- >>> lshift (4 :: Int) :: Sum Int+-- Sum {getSum = 4}+--+-- = Formal algebraic definitions+--+-- In algebraic terms, a subset @u@ of the set @x@ is a /generating set/ of the+-- action @LAct x s@ if for every @x :: x@, there exists a pair @(u,s) :: (u,s)@+-- such that @s <>$ u = x@. When the set @u@ is finite, the action @LAct x s@ is+-- said to be finitely generated. When the set @u@ is a singleton, the action is+-- said to be /cyclic/.+--+-- When the previous decomposition is unique, the action is said to be /free/.+-- If it is both free and cyclic, it is /1-free/.+--+-- (See /Monoids, Acts and Categories/ by Mati+-- Kilp, Ulrich Knauer, Alexander V. Mikhalev, definition 1.5.1, p.63.)+--+-- Remark : Freeness could be represented with classes @LActFree@ and+-- @LActOneFree@ that have no methods. Feel free to open an issue if you need+-- them.+--------------------------------------------------------------------------------+++module Data.Act.Cyclic+  ( -- * Cyclic actions+    LActCyclic (..)+  , lorigin+  , RActCyclic (..)+  , rorigin+  -- * Default newtypes+  , LDefault (..)+  , RDefault (..)+   -- * Action generated by a subset of generators+  , LActGen (..)+  , lgenerators+  , lgeneratorsList+  , lorigins+  , RActGen (..)+  , rgenerators+  , rgeneratorsList+  , rorigins+  )+  where+++import Data.Bifunctor+import Data.Functor.Identity+import Data.Coerce+import Data.Semigroup as Sg+import Data.Monoid as Mn+import Data.Proxy+import GHC.TypeLits+import GHC.Real++import Data.Default++++import Data.Act.Act+++-- | A left action generated by a single generator.+--+-- Instances must satisfy the following law :+--+-- * 'lshift' x @ <>$ 'lorigin' == x@+--+-- In other words, 'lorigin' is a generator of the action @LAct x s@.+--+class LAct x s => LActCyclic x s where+  -- | The only generator of the action @LAct x s@.+  --+  -- >>> lorigin' @Int @(Sum Int)+  -- 0+  --+  -- To avoid having to use the redundant first type aplication, use+  -- @'lorigin'@.+  --+  lorigin' :: x++  --- | Shifts an element of @x@ into an action @lshift x@ such that+  -- @lshift x <>$ lorigin == x@.+  --+  lshift :: x -> s++-- | A version of @'lorigin''@ such that the first type application is @s@.+--+-- >>> lorigin @(Sum Int) :: Int+-- 0+--+lorigin :: forall s x. LActCyclic x s => x+lorigin = lorigin' @x @s+{-# INLINE lorigin #-}+++-- | A right action generated by a single generator.+--+-- Instances must satisfy the following law :+--+-- * 'rorigin' @ $<> 'rshift' x == x@+--+-- In other words, 'rorigin' is a generator of the action @RAct x s@.+--+class RAct x s => RActCyclic x s where+  -- | The only generator of the action @RAct x s@.+  --+  -- >>> rorigin' @Int @(Sum Int) :: Int+  -- 0+  --+  -- To avoid having to use the redundant first type aplication, use+  -- @'rorigin'@.+  rorigin' :: x++  -- | Shifts an element of @x@ into an action @rshift x@ such that+  -- @rshift x $<> rorigin == x@.+  rshift :: x -> s++-- | A version of @'rorigin''@ such that the first type application is @s@.+--+-- >>> rorigin @(Sum Int) :: Int+-- 0+--+rorigin :: forall s x. RActCyclic x s => x+rorigin = rorigin' @x @s+{-# INLINE rorigin #-}+++++-- | A left action generated by a subset of generators @'lgenerators'@.+--+-- Intuitively, by acting repeteadly on generators with actions+-- of @s@, we can reach any element of @x@.+--+-- Since the generating subset of @x@ maybe infinite, we give two alternative+-- ways to define it : one using a characteristic function @'lgenerators'@ and+-- the other using a list @'lgeneratorsList'@.+--+-- All the above is summarized by the following law that all instances must+-- satisfy :+--+-- 1. 'snd' @('lshiftFromGen' x) <>$ 'fst' ('lshiftFromGen' x) == x@+-- 2. 'lgenerators'@  ('fst' $ 'lshiftFromGen' x) == True@+-- 3. 'lgenerators' @ x == x `'elem'` 'lgeneratorsList' proxy@+--+class LAct x s => LActGen x s where+  -- | The set of origins of the action @'LAct' x s@.+  --+  -- This is a subset of @x@, represented as its characteristic function,+  -- meaning the function that returns @True@ for all elements of @x@ that are+  -- origins of the action and @False@ otherwise.+  --+  -- To use @'lgenerators'@, you need TypeApplications:+  --+  -- >>> lgenerators' @Int @(Sum Int) 4+  -- False+  --+  -- >>> lgenerators' @Int @(Sum Int) 0+  -- True+  --+  -- To avoid having to use the redundant first type aplication, use+  -- @'lgenerators'@.+  lgenerators' :: x -> Bool+  default lgenerators' :: Eq x => x -> Bool+  lgenerators' x = x `elem` lgeneratorsList' @x @s++  -- | The set of origins of the action @LAct x s@ seen as a list.+  --+  -- You can let this function undefined if the set of origins cannot be+  -- represented as a list.+  --+  -- >>> lgeneratorsList' @Int @(Sum Int)+  -- [0]+  --+  -- To avoid having to use the redundant first type aplication, use+  -- @'lgeneratorsList'@.+  --+  lgeneratorsList' :: [x]+  default lgeneratorsList' :: LActCyclic x s => [x]+  lgeneratorsList' = [lorigin @s]++  -- | Returns a point's associated genrator @u@ along with an action @s@ such+  -- that @s <>$ u == x@.+  lshiftFromGen:: x -> (x,s)+  default lshiftFromGen :: LActCyclic x s => x -> (x,s)+  lshiftFromGen x = (lorigin @s, lshift x)++-- | A version of @'lgenerators''@ such that the first type application is @s@.+--+-- >>> lgenerators @(Sum Int) (4 :: Int)+-- False+--+-- >>> lgenerators @(Sum Int) (0 :: Int)+-- True+--+lgenerators :: forall s x. LActGen x s => x -> Bool+lgenerators = lgenerators' @x @s+{-# INLINE lgenerators #-}++-- | A version of @'lgeneratorsList''@ such that the first type application is+-- @s@.+--+-- >>> lgeneratorsList @(Sum Int) :: [Int]+-- [0]+--+lgeneratorsList :: forall s x. LActGen x s => [x]+lgeneratorsList = lgeneratorsList' @x @s+{-# INLINE lgeneratorsList #-}++-- | An alias for @'lgeneratorsList'@.+lorigins :: forall s x. LActGen x s => [x]+lorigins = lgeneratorsList @s+{-# INLINE lorigins #-}++++------------------------------------------------------------------------------++-- | A right action generated by a subset of generators @'lgenerators'@.+--+-- Intuitively, by acting repeteadly on generators with actions+-- of @s@, we can reach any element of @x@.+--+--+-- Since the generating subset of @x@ maybe infinite, we give two alternative+-- ways to define it : one using a characteristic function @'rgenerators'@ and+-- the other using a list @'rgeneratorsList'@.+--+-- All the above is summarized by the following law that all instances must+-- satisfy :+--+-- 1. 'rgenerators'@  ('fst' $ 'rshiftFromGen' x) == True@+-- 2. 'fst' ('rshiftFromGen' x) $<> 'snd' @('rshiftFromGen' x) == x@+-- 3. 'rgenerators' @x == x `'elem'` 'rgeneratorsList' x@+--+class RAct x s => RActGen x s where+  -- | The set of origins of the action @'RAct' x s@.+  --+  -- This is a subset of @x@, represented as its characteristic function,+  -- meaning the function that returns @True@ for all elements of @x@ that are+  -- origins of the action and @False@ otherwise.+  --+  -- To use @'rgenerators'@, you need TypeApplications:+  --+  -- >>> rgenerators' @(Sum Int) (4 :: Int)+  -- False+  --+  -- >>> rgenerators' @(Sum Int) (0 :: Int)+  -- True+  --+  -- To avoid having to use the redundant first type aplication, use+  -- @'rgenerators'@.+  rgenerators' :: x -> Bool+  default rgenerators' :: Eq x => x -> Bool+  rgenerators' x = x `elem` rgeneratorsList' @x @s+  {-# INLINE rgenerators' #-}++  -- | The set of origins of the action @RAct x s@ seen as a list.+  --+  -- You can let this function undefined if the set of origins cannot be+  -- represented as a list.+  --+  -- >>> rgeneratorsList' @(Sum Int) :: [Int]+  -- [0]+  --+  rgeneratorsList' :: [x]+  default rgeneratorsList' :: RActCyclic x s => [x]+  rgeneratorsList' = [rorigin @s]+  {-# INLINE rgeneratorsList' #-}++  -- | Returns a point's associated generator @u@ along with an action @s@ such+  -- that @u $<> s == x@.+  rshiftFromGen :: x -> (x,s)+  default rshiftFromGen :: RActCyclic x s => x -> (x,s)+  rshiftFromGen x = (rorigin @s, rshift x)+  {-# INLINE rshiftFromGen #-}++-- | A version of @'rgenerators''@ such that the first type application is @s@.+--+-- >>> rgenerators @(Sum Int) (4 :: Int)+-- False+--+-- >>> rgenerators @(Sum Int) (0 :: Int)+-- True+--+rgenerators :: forall s x. RActGen x s => x -> Bool+rgenerators = rgenerators' @x @s+{-# INLINE rgenerators #-}++-- | A version of @'rgeneratorsList''@ such that the first type application is+-- @s@.+--+-- >>> rgeneratorsList @(Sum Int) :: [Int]+-- [0]+--+rgeneratorsList :: forall s x. RActGen x s => [x]+rgeneratorsList = rgeneratorsList' @x @s+{-# INLINE rgeneratorsList #-}++-- | An alias for @'rgeneratorsList'@.+--+rorigins :: forall s x. RActGen x s => [x]+rorigins = rgeneratorsList @s+{-# INLINE rorigins #-}++------------------------------------------------------------------------------++-- | A semigroup that allows to define a default value for @'lorigin'@ thanks+-- to type level programming.+--+-- The semigroup returns the first value, just like @'Data.Semigroup.First'@,+-- i.e. verifies+--+-- @ LDefault x <> LDefault y == LDefault x @+--+-- [Usage:]+--+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+-- >>> lorigin @(LDefault 'True Bool) :: Bool+-- True+--+-- >>> lorigin @(LDefault 'False Bool) :: Bool+-- False+--+-- >>> lorigin @(LDefault 42 Int) :: Int+-- 42+--+-- >>> :set -XTypeOperators+-- >>> import GHC.Real+-- >>> lorigin @(LDefault (31415 :% 10000) Float) :: Float+-- 3.14159+--+-- @since lr-acts-0.0.2+--+newtype LDefault k x = LDefault x+  deriving (Semigroup, LAct x, LActSg x) via (Sg.First x)++instance Default a => LActCyclic a (LDefault () a) where+  lorigin' = def+  lshift = LDefault++instance LActCyclic Bool (LDefault 'True Bool) where+  lorigin' = True+  lshift = LDefault++instance LActCyclic Bool (LDefault 'False Bool) where+  lorigin' = False+  lshift = LDefault++instance (Num a, KnownNat n) => LActCyclic a (LDefault n a) where+  lorigin' = fromInteger (natVal (Proxy :: Proxy n))+  lshift = LDefault++instance (Fractional a, KnownNat n, KnownNat m)+  => LActCyclic a (LDefault (n :% m) a) where+  lorigin' = fromInteger (natVal (Proxy :: Proxy n))+          / fromInteger (natVal (Proxy :: Proxy m))+  lshift = LDefault++-- | Same as @'LDefault'@, but for right actions.+--+-- The semigroup returns the first value, just like @'Data.Semigroup.Last'@,+-- i.e. verifies+--+-- @ RDefault x <> RDefault y == RDefault y @+--+-- @since lr-acts-0.0.2+--+newtype RDefault (a :: k) x = RDefault x+  deriving (Semigroup, RAct x, RActSg x) via (Sg.Last x)++instance Default a => RActCyclic a (RDefault () a) where+  rorigin' = def+  rshift = RDefault++instance RActCyclic Bool (RDefault 'True Bool) where+  rorigin' = True+  rshift = RDefault++instance RActCyclic Bool (RDefault 'False Bool) where+  rorigin' = True+  rshift = RDefault++instance (Num a, KnownNat n) => RActCyclic a (RDefault n a) where+  rorigin' = fromInteger (natVal (Proxy :: Proxy n))+  rshift = RDefault++instance (Fractional a, KnownNat n, KnownNat m)+  => RActCyclic a (RDefault (n :% m) a) where+  rorigin' = fromInteger (natVal (Proxy :: Proxy n))+          / fromInteger (natVal (Proxy :: Proxy n))+  rshift = RDefault+++---------------------------------- Instances -----------------------------------++-- Unit --++instance Default x => LActCyclic x () where+  lorigin' = def+  {-# INLINE lorigin' #-}+  lshift _ = ()+  {-# INLINE lshift #-}++instance Default x => RActCyclic x () where+  rorigin' = def+  {-# INLINE rorigin' #-}+  rshift _ = ()+  {-# INLINE rshift #-}+++-- Identity --++instance LActGen x s => LActGen (Identity x) (Identity s) where+  lgenerators' (Identity x) = lgenerators @s x+  {-# INLINE lgenerators' #-}+  lgeneratorsList' = Identity <$> lgeneratorsList @s+  {-# INLINE lgeneratorsList' #-}+  lshiftFromGen (Identity x) = bimap Identity Identity $ lshiftFromGen x+  {-# INLINE lshiftFromGen #-}++instance LActCyclic x s => LActCyclic (Identity x) (Identity s) where+  lorigin' = Identity (lorigin @s)+  {-# INLINE lorigin' #-}+  lshift (Identity x) = Identity (lshift x)+  {-# INLINE lshift #-}++instance RActGen x s => RActGen (Identity x) (Identity s) where+  rgenerators' (Identity x) = rgenerators @s x+  {-# INLINE rgenerators' #-}+  rgeneratorsList' = Identity <$> rgeneratorsList @s+  {-# INLINE rgeneratorsList' #-}+  rshiftFromGen (Identity x) = bimap Identity Identity $ rshiftFromGen x+  {-# INLINE rshiftFromGen #-}++instance RActCyclic x s => RActCyclic (Identity x) (Identity s) where+  rorigin' = Identity (rorigin @s)+  {-# INLINE rorigin' #-}+  rshift (Identity x) = Identity (rshift x)+  {-# INLINE rshift #-}++-- ActSelf --++instance (Eq s, Monoid s) => LActGen s (ActSelf s)++instance Monoid s => LActCyclic s (ActSelf s) where+  lorigin' = mempty+  {-# INLINE lorigin' #-}+  lshift = ActSelf+  {-# INLINE lshift #-}++instance (Eq s, Monoid s) => RActGen s (ActSelf s)++instance Monoid s => RActCyclic s (ActSelf s) where+  rorigin' = mempty+  {-# INLINE rorigin' #-}+  rshift = ActSelf+  {-# INLINE rshift #-}+++-- ActSelf' --++instance (Eq x, Coercible x s, Monoid s) => LActGen x (ActSelf' s)++instance (Coercible x s, Monoid s) => LActCyclic x (ActSelf' s) where+  lorigin' = coerce (mempty :: s)+  {-# INLINE lorigin' #-}+  lshift = coerce+  {-# INLINE lshift #-}++instance (Eq x, Coercible x s, Monoid s) => RActGen x (ActSelf' s)++instance (Coercible x s, Monoid s) => RActCyclic x (ActSelf' s) where+  rorigin' = coerce (mempty :: s)+  {-# INLINE rorigin' #-}+  rshift = coerce+  {-# INLINE rshift #-}++-- Sum --++instance (Eq x, Num x) => LActGen x (Sum x)++instance Num x => LActCyclic x (Sum x) where+  lorigin' = 0+  {-# INLINE lorigin' #-}+  lshift = Sum+  {-# INLINE lshift #-}++instance (Eq x, Num x) => RActGen x (Sum x)++instance Num x => RActCyclic x (Sum x) where+  rorigin' = 0+  {-# INLINE rorigin' #-}+  rshift = Sum+  {-# INLINE rshift #-}++-- Product --++instance (Eq x, Num x) => LActGen x (Product x)++instance Num x => LActCyclic x (Product x) where+  lorigin' = 1+  {-# INLINE lorigin' #-}+  lshift = Product+  {-# INLINE lshift #-}++instance (Eq x, Num x) => RActGen x (Product x)++instance Num x => RActCyclic x (Product x) where+  rorigin' = 1+  {-# INLINE rorigin' #-}+  rshift = Product+  {-# INLINE rshift #-}++-- Product on Sum --++instance (Eq x, Num x) => LActGen (Sum x) (Product x)++instance Num x => LActCyclic (Sum x) (Product x) where+  lorigin' = 1+  {-# INLINE lorigin' #-}+  lshift = coerce+  {-# INLINE lshift #-}++instance (Eq x, Num x) => RActGen (Sum x) (Product x)++instance Num x => RActCyclic (Sum x) (Product x) where+  rorigin' = 1+  {-# INLINE rorigin' #-}+  rshift = coerce+  {-# INLINE rshift #-}++-- First --++instance Default x => LActCyclic x (Sg.First x) where+  lorigin' = def+  lshift = Sg.First++instance Default x => LActCyclic x (Mn.First x) where+  lorigin' = def+  lshift = Mn.First . Just++instance Default x => RActCyclic x (Sg.Last x) where+  rorigin' = def+  rshift = Sg.Last++instance Default x => RActCyclic x (Mn.Last x) where+  rorigin' = def+  rshift = Mn.Last . Just+

@@ -1,210 +1,207 @@-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE ScopedTypeVariables    #-}
-
---------------------------------------------------------------------------------
--- |
---
--- Module      :  Data.Act.Torsor
--- Description :  Group torsors for left and right actions.
--- Copyright   :  (c) Alice Rixte 2025
--- License     :  BSD 3
--- Maintainer  :  alice.rixte@u-bordeaux.fr
--- Stability   :  unstable
--- Portability :  non-portable (GHC extensions)
---
--- == Presentation
---
--- Torsors are sets for which the /differences/ between elements form a group.
--- One good example is time : it does not make sense to add or substract two
--- dates together so we should model these dates as a set (we keep this simple by using only days):
---
--- >>> newtype Days = Days Int
---         deriving Show
---
--- But subtracting two dates together does makes sense. This is where LTorsor
--- can become useful :
---
--- @
--- newtype Duration = Duration Days
---   deriving Show
---   deriving (Semigroup, Monoid, Group) via Sum Int
---   deriving (LAct Days, LActSg Days, LActMn Days, LTorsor Days)
---            via (ActSelf' (Sum Int))
--- @
---
--- Now only @Duration@ can be added or subtracted together and not dates.
---
--- >>> (Days 5 .-. Days 3 :: Duration) + (Days 7 .-. Days 5)
--- Duration (Days 4)
---
---
--- For a more details and examples see this
--- [article](https://math.ucr.edu/home/baez/torsors.html)
---
---------------------------------------------------------------------------------
-
-module Data.Act.Torsor
-  ( LTorsor (..)
-  , RTorsor (..)
-  )
-where
-
-import Data.Coerce
-import Data.Functor.Identity
-import Data.Monoid
-
-import Data.Group
-
-import Data.Act.Act
-
--- | A left group torsor.
---
--- The most well known example of a torsor is the particular case of an affine
--- space where the group is the additive group of the vector space and the set
--- is a set of points. Torsors are more general than affine spaces since they
--- don't enforce linearity. Notice that 'LActDistrib' may correspond to a
--- linearity condition if you need one.
---
--- See this nLab article for more information :
--- https://ncatlab.org/nlab/show/torsor
---
--- [In algebraic terms : ]
---
--- A left group action is a torsor if and only if for every pair @(x,y) :: (x,
--- x)@, there exists a unique group element @g :: g@ such that @g <>$ x = y@.
---
--- [In Haskell terms : ]
---
--- Instances must satisfy the following law :
---
--- * @ y .-. x <>$ x == @ @y@
--- * if @g <>$ x == y@ then @g == y .-. x@
---
-class LActGp x g => LTorsor x g where
-  {-# MINIMAL ldiff | (.-.) #-}
-  -- | @ldiff y x@ is the only group element such that @'ldiff' y x <>$ x = y@.
-  ldiff :: x -> x -> g
-  ldiff y x = y .-. x
-  infix 6 `ldiff`
-  {-# INLINE ldiff #-}
-
-  -- | Infix synonym for 'ldiff'.
-  --
-  -- This represents a point minus a point.
-  --
-  (.-.) :: x -> x -> g
-  (.-.) = ldiff
-  infix 6 .-.
-  {-# INLINE (.-.) #-}
-
-
-instance LTorsor x () where
-  ldiff _ _ = ()
-  {-# INLINE ldiff #-}
-
-instance LTorsor x g => LTorsor x (Identity g) where
-  ldiff y x = Identity (ldiff y x)
-  {-# INLINE ldiff #-}
-
-instance (LTorsor x g, LTorsor y h) => LTorsor (x, y) (g,h) where
-  ldiff (y1, y2) (x1, x2) = (ldiff y1 x1, ldiff y2 x2)
-  {-# INLINE ldiff #-}
-
-instance {-# OVERLAPPING #-} LTorsor x g
-  => LTorsor (Identity x) (Identity g) where
-  ldiff (Identity y) (Identity x) = Identity (ldiff y x)
-  {-# INLINE ldiff #-}
-
-
-instance Group g => LTorsor g (ActSelf g) where
-  ldiff y x = ActSelf (y ~~ x)
-  {-# INLINE ldiff #-}
-
-instance (Group g, Coercible x g) => LTorsor x (ActSelf' g) where
-  ldiff y x = ActSelf' ((coerce y :: g) ~~ (coerce x :: g))
-  {-# INLINE ldiff #-}
-
-
-instance RTorsor x g => LTorsor x (Dual g) where
-  ldiff y x = Dual (rdiff y x)
-  {-# INLINE ldiff #-}
-
-instance Num x => LTorsor x (Sum x) where
-  ldiff y x = Sum (y - x)
-  {-# INLINE ldiff #-}
-
-instance Fractional x => LTorsor x (Product x) where
-  ldiff y x = Product (y / x)
-  {-# INLINE ldiff #-}
-
-
-
--- | A right group torsor.
---
--- [In algebraic terms : ]
---
--- A left group action is a torsor if and only if for every pair @(x,y) :: (x,
--- x)@, there exists a unique group element @g :: g@ such that @g <>$ x = y@.
---
--- [In Haskell terms : ]
---
--- Instances must satisfy the following law :
---
--- * @ x $<> y .~. x == @ @y@
--- * if @x $<> g == y@ then @g == y .~. x@
---
-class RActGp x g => RTorsor x g where
-  {-# MINIMAL rdiff | (.~.) #-}
-  -- | @rdiff y x@ is the only group element such that @'rdiff' y x $<> x = y@.
-  rdiff :: x -> x -> g
-  rdiff y x = y .~. x
-  infix 6 `rdiff`
-  {-# INLINE rdiff #-}
-
-  -- | Infix synonym for 'rdiff'.
-  --
-  -- This represents a point minus a point.
-  --
-  (.~.) :: x -> x -> g
-  (.~.) = rdiff
-  infix 6 .~.
-  {-# INLINE (.~.) #-}
-
-instance RTorsor x () where
-  rdiff _ _ = ()
-  {-# INLINE rdiff #-}
-
-instance RTorsor x g => RTorsor x (Identity g) where
-  rdiff y x = Identity (rdiff y x)
-  {-# INLINE rdiff #-}
-
-instance {-# OVERLAPPING #-} RTorsor x g
-  => RTorsor (Identity x) (Identity g) where
-  rdiff (Identity y) (Identity x) = Identity (rdiff y x)
-  {-# INLINE rdiff #-}
-
-instance (RTorsor x g, RTorsor y h) => RTorsor (x, y) (g,h) where
-  rdiff (y1, y2) (x1, x2) = (rdiff y1 x1, rdiff y2 x2)
-  {-# INLINE rdiff #-}
-
-instance Group g => RTorsor g (ActSelf g) where
-  rdiff y x = ActSelf (y ~~ x)
-  {-# INLINE rdiff #-}
-
-instance (Group g, Coercible x g) => RTorsor x (ActSelf' g) where
-  rdiff y x = ActSelf' ((coerce y :: g) ~~ (coerce x :: g))
-  {-# INLINE rdiff #-}
-
-instance LTorsor x g => RTorsor x (Dual g) where
-  rdiff y x = Dual (ldiff y x)
-  {-# INLINE rdiff #-}
-
-instance Num x => RTorsor x (Sum x) where
-  rdiff y x = Sum (y - x)
-  {-# INLINE rdiff #-}
-
-instance Fractional x => RTorsor x (Product x) where
-  rdiff y x = Product (y / x)
-  {-# INLINE rdiff #-}
-
+--------------------------------------------------------------------------------+-- |+--+-- Module      :  Data.Act.Torsor+-- Description :  Group torsors for left and right actions.+-- Copyright   :  (c) Alice Rixte 2025+-- License     :  BSD 3+-- Maintainer  :  alice.rixte@u-bordeaux.fr+-- Stability   :  unstable+-- Portability :  non-portable (GHC extensions)+--+-- == Presentation+--+-- Torsors are sets for which the /differences/ between elements form a group.+-- One good example is time : it does not make sense to add two dates together+-- so we should model these dates as a set (we keep this simple by using only+-- days):+--+-- >>> newtype Days = Days Int+--         deriving Show+--+-- But subtracting two dates together does makes sense. This is where LTorsor+-- can become useful :+--+-- @+-- newtype Duration = Duration Days+--   deriving Show+--   deriving (Semigroup, Monoid, Group) via Sum Int+--   deriving (LAct Days, LActSg Days, LActMn Days, LTorsor Days)+--            via (ActSelf' (Sum Int))+-- @+--+-- Now only @Duration@ can be added or subtracted together and not dates.+--+-- >>> (Days 5 .-. Days 3 :: Duration) + (Days 7 .-. Days 5)+-- Duration (Days 4)+--+--+-- For a more details and examples see this+-- [article](https://math.ucr.edu/home/baez/torsors.html)+--+--------------------------------------------------------------------------------++module Data.Act.Torsor+  ( LTorsor (..)+  , RTorsor (..)+  )+where++import Data.Coerce+import Data.Functor.Identity+import Data.Monoid++import Data.Group++import Data.Act.Act++-- | A left group torsor.+--+-- The most well known example of a torsor is the particular case of an affine+-- space where the group is the additive group of the vector space and the set+-- is a set of points. Torsors are more general than affine spaces since they+-- don't enforce linearity. Notice that 'LActDistrib' may correspond to a+-- linearity condition if you need one.+--+-- See this nLab article for more information :+-- https://ncatlab.org/nlab/show/torsor+--+-- [In algebraic terms : ]+--+-- A left group action is a torsor if and only if for every pair @(x,y) :: (x,+-- x)@, there exists a unique group element @g :: g@ such that @g <>$ x = y@.+--+-- [In Haskell terms : ]+--+-- Instances must satisfy the following law :+--+-- * @ y .-. x <>$ x == @ @y@+-- * if @g <>$ x == y@ then @g == y .-. x@+--+class LActGp x g => LTorsor x g where+  {-# MINIMAL ldiff | (.-.) #-}+  -- | @ldiff y x@ is the only group element such that @'ldiff' y x <>$ x = y@.+  ldiff :: x -> x -> g+  ldiff y x = y .-. x+  infix 6 `ldiff`+  {-# INLINE ldiff #-}++  -- | Infix synonym for 'ldiff'.+  --+  -- This represents a point minus a point.+  --+  (.-.) :: x -> x -> g+  (.-.) = ldiff+  infix 6 .-.+  {-# INLINE (.-.) #-}+++instance LTorsor x () where+  ldiff _ _ = ()+  {-# INLINE ldiff #-}++instance LTorsor x g => LTorsor x (Identity g) where+  ldiff y x = Identity (ldiff y x)+  {-# INLINE ldiff #-}++instance (LTorsor x g, LTorsor y h) => LTorsor (x, y) (g,h) where+  ldiff (y1, y2) (x1, x2) = (ldiff y1 x1, ldiff y2 x2)+  {-# INLINE ldiff #-}++instance {-# OVERLAPPING #-} LTorsor x g+  => LTorsor (Identity x) (Identity g) where+  ldiff (Identity y) (Identity x) = Identity (ldiff y x)+  {-# INLINE ldiff #-}+++instance Group g => LTorsor g (ActSelf g) where+  ldiff y x = ActSelf (y ~~ x)+  {-# INLINE ldiff #-}++instance (Group g, Coercible x g) => LTorsor x (ActSelf' g) where+  ldiff y x = ActSelf' ((coerce y :: g) ~~ (coerce x :: g))+  {-# INLINE ldiff #-}+++instance RTorsor x g => LTorsor x (Dual g) where+  ldiff y x = Dual (rdiff y x)+  {-# INLINE ldiff #-}++instance Num x => LTorsor x (Sum x) where+  ldiff y x = Sum (y - x)+  {-# INLINE ldiff #-}++instance Fractional x => LTorsor x (Product x) where+  ldiff y x = Product (y / x)+  {-# INLINE ldiff #-}++++-- | A right group torsor.+--+-- [In algebraic terms : ]+--+-- A left group action is a torsor if and only if for every pair @(x,y) :: (x,+-- x)@, there exists a unique group element @g :: g@ such that @g <>$ x = y@.+--+-- [In Haskell terms : ]+--+-- Instances must satisfy the following law :+--+-- * @ x $<> y .~. x == @ @y@+-- * if @x $<> g == y@ then @g == y .~. x@+--+class RActGp x g => RTorsor x g where+  {-# MINIMAL rdiff | (.~.) #-}+  -- | @rdiff y x@ is the only group element such that @'rdiff' y x $<> x = y@.+  rdiff :: x -> x -> g+  rdiff y x = y .~. x+  infix 6 `rdiff`+  {-# INLINE rdiff #-}++  -- | Infix synonym for 'rdiff'.+  --+  -- This represents a point minus a point.+  --+  (.~.) :: x -> x -> g+  (.~.) = rdiff+  infix 6 .~.+  {-# INLINE (.~.) #-}++instance RTorsor x () where+  rdiff _ _ = ()+  {-# INLINE rdiff #-}++instance RTorsor x g => RTorsor x (Identity g) where+  rdiff y x = Identity (rdiff y x)+  {-# INLINE rdiff #-}++instance {-# OVERLAPPING #-} RTorsor x g+  => RTorsor (Identity x) (Identity g) where+  rdiff (Identity y) (Identity x) = Identity (rdiff y x)+  {-# INLINE rdiff #-}++instance (RTorsor x g, RTorsor y h) => RTorsor (x, y) (g,h) where+  rdiff (y1, y2) (x1, x2) = (rdiff y1 x1, rdiff y2 x2)+  {-# INLINE rdiff #-}++instance Group g => RTorsor g (ActSelf g) where+  rdiff y x = ActSelf (y ~~ x)+  {-# INLINE rdiff #-}++instance (Group g, Coercible x g) => RTorsor x (ActSelf' g) where+  rdiff y x = ActSelf' ((coerce y :: g) ~~ (coerce x :: g))+  {-# INLINE rdiff #-}++instance LTorsor x g => RTorsor x (Dual g) where+  rdiff y x = Dual (ldiff y x)+  {-# INLINE rdiff #-}++instance Num x => RTorsor x (Sum x) where+  rdiff y x = Sum (y - x)+  {-# INLINE rdiff #-}++instance Fractional x => RTorsor x (Product x) where+  rdiff y x = Product (y / x)+  {-# INLINE rdiff #-}+

@@ -1,16 +1,16 @@------------------------------------------------------------------------------
--- |
---   Module      :  Data.Semigroup.Semidirect
---   Copyright   :  (c) Alice Rixte (2024)
---   License     :  BSD 3 (see LICENSE)
---   Maintainer  :  alice.rixte@u-bordeaux.fr
---
--- This is a re-export of "Data.Semigroup.Semidirect.Lazy". If you need a strict
--- version, please import "Data.Semigroup.Semidirect.Strict".
---
------------------------------------------------------------------------------
-module Data.Semidirect
-    ( module Data.Semidirect.Lazy
-    ) where
-
+-----------------------------------------------------------------------------+-- |+--   Module      :  Data.Semigroup.Semidirect+--   Copyright   :  (c) Alice Rixte (2024)+--   License     :  BSD 3 (see LICENSE)+--   Maintainer  :  alice.rixte@u-bordeaux.fr+--+-- This is a re-export of "Data.Semigroup.Semidirect.Lazy". If you need a strict+-- version, please import "Data.Semigroup.Semidirect.Strict".+--+-----------------------------------------------------------------------------+module Data.Semidirect+    ( module Data.Semidirect.Lazy+    ) where+ import Data.Semidirect.Lazy

@@ -1,144 +1,139 @@-{-# LANGUAGE FlexibleInstances            #-}
-{-# LANGUAGE MultiParamTypeClasses        #-}
-{-# LANGUAGE InstanceSigs                 #-}
-{-# LANGUAGE ScopedTypeVariables          #-}
-
------------------------------------------------------------------------------
--- |
--- Module      : Data.Semidirect.Lazy
--- Description : Lazy semidirect products
--- Copyright   : (c) Alice Rixte 2025
--- License     : BSD 3
--- Maintainer  : alice.rixte@u-bordeaux.fr
--- Stability   : unstable
--- Portability : non-portable (GHC extensions)
---
--- Semidirect products for left and right actions.
---
--- For a strict version, see @'Data.Semidirect.Strict'@.
---
--- [Usage :]
---
--- >>> import Data.Semigroup
--- >>> LSemidirect (Sum 1) (Product 2) <> LSemidirect (Sum (3 :: Int)) (Product (4 :: Int))
--- LSemidirect {lactee = Sum {getSum = 7}, lactor = Product {getProduct = 8}}
---
--- [Property checking :]
---
--- There is a @'Semigroup'@ instance for @'LSemidirect'@ (resp. @'RSemidirect'@)
--- only if there is a @'LActSgMorph'@ (resp. @'RActSgMorph'@) instance. For
--- example, @'Sum' Int@ acting on itself is not a semigroup action by morphism
--- and therefore the semidirect product is not associative :
---
--- >>> LSemidirect (Sum 1) (Sum 2) <> LSemidirect (Sum (3 :: Int)) (Sum (4 :: Int))
--- No instance for `LActDistrib (Sum Int) (Sum Int)'
---   arising from a use of `<>'
---
------------------------------------------------------------------------------
-
-module Data.Semidirect.Lazy
-       ( LSemidirect (..)
-       , lerase
-       , lforget
-       , lembedActee
-       , lembedActor
-       , lfromPair
-        , RSemidirect (..)
-        , rerase
-        , rforget
-        , rembedActee
-        , rembedActor
-        , rfromPair
-       ) where
-
-import Data.Bifunctor
-import Data.Act
-
--- | A semi-direct product for a left action, where @s@ acts on @x@
---
-data LSemidirect x s = LSemidirect
-  { lactee :: x -- ^ The value being acted on
-  , lactor :: s -- ^ The acting element
-  }
-  deriving (Show, Read, Eq)
-
-instance LActSgMorph x s
-  => Semigroup (LSemidirect x s) where
-  ~(LSemidirect x s) <> ~(LSemidirect x' s') =
-    LSemidirect  (x <> (s <>$ x')) (s <> s')
-
-instance LActMnMorph x s => Monoid (LSemidirect x s) where
-  mempty = LSemidirect mempty mempty
-
-instance Functor (LSemidirect x) where
-  fmap f a = a {lactor = f (lactor a)}
-
-instance Bifunctor LSemidirect where
-  first f a = a {lactee = f (lactee a)}
-  second = fmap
-
--- |  Erases the actee (i.e. replace it with @mempty@).
-lerase :: Monoid x => LSemidirect x s -> LSemidirect x s
-lerase a = a {lactee = mempty}
-
--- |  Forget the actor (i.e. replace it with @mempty@).
-lforget :: Monoid s => LSemidirect x s -> LSemidirect x s
-lforget a =a {lactor = mempty}
-
--- |  Make a semidirect pair whose actee is @mempty@.
-lembedActor :: Monoid x => s -> LSemidirect x s
-lembedActor s = LSemidirect mempty s
-
--- |  Make a semidirect pair whose actor is @mempty@.
-lembedActee :: Monoid s => x -> LSemidirect x s
-lembedActee x = LSemidirect x mempty
-
--- | Converts a pair into a semidirect product element.
-lfromPair :: (x,s) -> LSemidirect x s
-lfromPair (x,s) = LSemidirect x s
-
-
-------------------------------------------------------------------------------
-
--- |  A semidirect product for a right action, where @s@ acts on @x@
---
-data RSemidirect x s = RSemidirect
-  { ractee :: x -- ^ The value being acted on
-  , ractor :: s -- ^ The acting element
-  }
-  deriving (Show, Read, Eq)
-
-instance RActSgMorph x s
-  => Semigroup (RSemidirect x s) where
-  ~(RSemidirect x s) <> ~(RSemidirect x' s') =
-    RSemidirect  (x <> (x' $<> s)) (s <> s')
-
-instance RActMnMorph x s => Monoid (RSemidirect x s) where
-  mempty = RSemidirect mempty mempty
-
-instance Functor (RSemidirect x) where
-  fmap f a = a {ractor = f (ractor a)}
-
-instance Bifunctor RSemidirect where
-  first f a = a {ractee = f (ractee a)}
-  second = fmap
-
--- |  Erase the actee (i.e. replace it with @mempty@).
-rerase :: Monoid x => RSemidirect x s -> RSemidirect x s
-rerase a = a {ractee = mempty}
-
--- |  Forget the actor (i.e. replace it with @mempty@).
-rforget :: Monoid s => RSemidirect x s -> RSemidirect x s
-rforget a = a {ractor = mempty}
-
--- |  Make a semidirect pair whose actee is @mempty@.
-rembedActor :: Monoid x => s -> RSemidirect x s
-rembedActor s = RSemidirect mempty s
-
--- |  Make a semidirect pair whose actor element is @mempty@ .
-rembedActee :: Monoid s => x -> RSemidirect x s
-rembedActee x = RSemidirect x mempty
-
--- | Convert a pair into a semidirect product element
-rfromPair :: (x,s) -> RSemidirect x s
-rfromPair (x,s) = RSemidirect x s
+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Semidirect.Lazy+-- Description : Lazy semidirect products+-- Copyright   : (c) Alice Rixte 2025+-- License     : BSD 3+-- Maintainer  : alice.rixte@u-bordeaux.fr+-- Stability   : unstable+-- Portability : non-portable (GHC extensions)+--+-- Semidirect products for left and right actions.+--+-- For a strict version, see @'Data.Semidirect.Strict'@.+--+-- [Usage :]+--+-- >>> import Data.Semigroup+-- >>> LPair (Sum 1) (Product 2) <> LPair (Sum (3 :: Int)) (Product (4 :: Int))+-- LPair {lactee = Sum {getSum = 7}, lactor = Product {getProduct = 8}}+--+-- [Property checking :]+--+-- There is a @'Semigroup'@ instance for @'LSemidirect'@ (resp. @'RSemidirect'@)+-- only if there is a @'LActSgMorph'@ (resp. @'RActSgMorph'@) instance. For+-- example, @'Sum' Int@ acting on itself is not a semigroup action by morphism+-- and therefore the semidirect product is not associative :+--+-- >>> LPair (Sum 1) (Sum 2) <> LPair (Sum (3 :: Int)) (Sum (4 :: Int))+-- No instance for `LActDistrib (Sum Int) (Sum Int)'+--   arising from a use of `<>'+--+-----------------------------------------------------------------------------++module Data.Semidirect.Lazy+       ( LSemidirect (..)+       , lerase+       , lforget+       , lembedActee+       , lembedActor+       , lfromPair+        , RSemidirect (..)+        , rerase+        , rforget+        , rembedActee+        , rembedActor+        , rfromPair+       ) where++import Data.Bifunctor+import Data.Act++-- | A semi-direct product for a left action, where @s@ acts on @x@+--+data LSemidirect x s = LPair+  { lactee :: x -- ^ The value being acted on+  , lactor :: s -- ^ The acting element+  }+  deriving (Show, Read, Eq)++instance LActSgMorph x s+  => Semigroup (LSemidirect x s) where+  ~(LPair x s) <> ~(LPair x' s') =+    LPair  (x <> (s <>$ x')) (s <> s')++instance LActMnMorph x s => Monoid (LSemidirect x s) where+  mempty = LPair mempty mempty++instance Functor (LSemidirect x) where+  fmap f a = a {lactor = f (lactor a)}++instance Bifunctor LSemidirect where+  first f a = a {lactee = f (lactee a)}+  second = fmap++-- |  Erases the actee (i.e. replace it with @mempty@).+lerase :: Monoid x => LSemidirect x s -> LSemidirect x s+lerase a = a {lactee = mempty}++-- |  Forget the actor (i.e. replace it with @mempty@).+lforget :: Monoid s => LSemidirect x s -> LSemidirect x s+lforget a =a {lactor = mempty}++-- |  Make a semidirect pair whose actee is @mempty@.+lembedActor :: Monoid x => s -> LSemidirect x s+lembedActor s = LPair mempty s++-- |  Make a semidirect pair whose actor is @mempty@.+lembedActee :: Monoid s => x -> LSemidirect x s+lembedActee x = LPair x mempty++-- | Converts a pair into a semidirect product element.+lfromPair :: (x,s) -> LSemidirect x s+lfromPair (x,s) = LPair x s+++------------------------------------------------------------------------------++-- |  A semidirect product for a right action, where @s@ acts on @x@+--+data RSemidirect x s = RPair+  { ractee :: x -- ^ The value being acted on+  , ractor :: s -- ^ The acting element+  }+  deriving (Show, Read, Eq)++instance RActSgMorph x s+  => Semigroup (RSemidirect x s) where+  ~(RPair x s) <> ~(RPair x' s') =+    RPair  (x <> (x' $<> s)) (s <> s')++instance RActMnMorph x s => Monoid (RSemidirect x s) where+  mempty = RPair mempty mempty++instance Functor (RSemidirect x) where+  fmap f a = a {ractor = f (ractor a)}++instance Bifunctor RSemidirect where+  first f a = a {ractee = f (ractee a)}+  second = fmap++-- |  Erase the actee (i.e. replace it with @mempty@).+rerase :: Monoid x => RSemidirect x s -> RSemidirect x s+rerase a = a {ractee = mempty}++-- |  Forget the actor (i.e. replace it with @mempty@).+rforget :: Monoid s => RSemidirect x s -> RSemidirect x s+rforget a = a {ractor = mempty}++-- |  Make a semidirect pair whose actee is @mempty@.+rembedActor :: Monoid x => s -> RSemidirect x s+rembedActor s = RPair mempty s++-- |  Make a semidirect pair whose actor element is @mempty@ .+rembedActee :: Monoid s => x -> RSemidirect x s+rembedActee x = RPair x mempty++-- | Convert a pair into a semidirect product element+rfromPair :: (x,s) -> RSemidirect x s+rfromPair (x,s) = RPair x s

@@ -1,144 +1,139 @@-{-# LANGUAGE FlexibleInstances            #-}
-{-# LANGUAGE MultiParamTypeClasses        #-}
-{-# LANGUAGE InstanceSigs                 #-}
-{-# LANGUAGE ScopedTypeVariables          #-}
-
------------------------------------------------------------------------------
--- |
--- Module      : Data.Semidirect.Strict
--- Description : Strict semidirect products
--- Copyright   : (c) Alice Rixte 2025
--- License     : BSD 3
--- Maintainer  : alice.rixte@u-bordeaux.fr
--- Stability   : unstable
--- Portability : non-portable (GHC extensions)
---
--- Semidirect products for left and right actions.
---
--- For a lazy version, see @'Data.Semidirect.Lazy'@.
---
--- [Usage :]
---
--- >>> import Data.Semigroup
--- >>> LSemidirect (Sum 1) (Product 2) <> LSemidirect (Sum (3 :: Int)) (Product (4 :: Int))
--- LSemidirect {lactee = Sum {getSum = 7}, lactor = Product {getProduct = 8}}
---
--- [Property checking :]
---
--- There is a @'Semigroup'@ instance for @'LSemidirect'@ (resp. @'RSemidirect'@)
--- only if there is a @'LActSgMorph'@ (resp. @'RActSgMorph'@) instance. For
--- example, @'Sum' Int@ acting on itself is not a semigroup action by morphism
--- and therefore the semidirect product is not associative :
---
--- >>> LSemidirect (Sum 1) (Sum 2) <> LSemidirect (Sum (3 :: Int)) (Sum (4 :: Int))
--- No instance for `LActDistrib (Sum Int) (Sum Int)'
---   arising from a use of `<>'
---
------------------------------------------------------------------------------
-
-module Data.Semidirect.Strict
-       ( LSemidirect (..)
-       , lerase
-       , lforget
-       , lembedActee
-       , lembedActor
-       , lfromPair
-        , RSemidirect (..)
-        , rerase
-        , rforget
-        , rembedActee
-        , rembedActor
-        , rfromPair
-       ) where
-
-import Data.Bifunctor
-import Data.Act
-
--- | A semi-direct product for a left action, where @s@ acts on @x@
---
-data LSemidirect x s = LSemidirect
-  { lactee :: !x -- ^ The value being acted on
-  , lactor :: !s -- ^ The acting element
-  }
-  deriving (Show, Read, Eq)
-
-instance LActSgMorph x s
-  => Semigroup (LSemidirect x s) where
-  LSemidirect x s <> LSemidirect x' s' =
-    LSemidirect  (x <> (s <>$ x')) (s <> s')
-
-instance LActMnMorph x s => Monoid (LSemidirect x s) where
-  mempty = LSemidirect mempty mempty
-
-instance Functor (LSemidirect x) where
-  fmap f a = a {lactor = f (lactor a)}
-
-instance Bifunctor LSemidirect where
-  first f a = a {lactee = f (lactee a)}
-  second = fmap
-
--- |  Erase the actee (i.e. replace it with @mempty@).
-lerase :: Monoid x => LSemidirect x s -> LSemidirect x s
-lerase a = a {lactee = mempty}
-
--- |  Forget the actor (i.e. replace it with @mempty@).
-lforget :: Monoid s => LSemidirect x s -> LSemidirect x s
-lforget a =a {lactor = mempty}
-
--- |  Make a semidirect pair whose actee is @mempty@.
-lembedActor :: Monoid x => s -> LSemidirect x s
-lembedActor s = LSemidirect mempty s
-
--- |  Make a semidirect pair whose actor is @mempty@.
-lembedActee :: Monoid s => x -> LSemidirect x s
-lembedActee x = LSemidirect x mempty
-
--- | Convert a pair into a semidirect product element.
-lfromPair :: (x,s) -> LSemidirect x s
-lfromPair (x,s) = LSemidirect x s
-
-
-------------------------------------------------------------------------------
-
--- |  A semidirect product for a right action, where @s@ acts on @x@
---
-data RSemidirect x s = RSemidirect
-  { ractee :: !x -- ^ The value being acted on
-  , ractor :: !s -- ^ The acting element
-  }
-  deriving (Show, Read, Eq)
-
-instance RActSgMorph x s
-  => Semigroup (RSemidirect x s) where
-  RSemidirect x s <> RSemidirect x' s' =
-    RSemidirect  (x <> (x' $<> s)) (s <> s')
-
-instance RActMnMorph x s => Monoid (RSemidirect x s) where
-  mempty = RSemidirect mempty mempty
-
-instance Functor (RSemidirect x) where
-  fmap f a = a {ractor = f (ractor a)}
-
-instance Bifunctor RSemidirect where
-  first f a = a {ractee = f (ractee a)}
-  second = fmap
-
--- |  Erase the actee (i.e. replace it with @mempty@).
-rerase :: Monoid x => RSemidirect x s -> RSemidirect x s
-rerase a = a {ractee = mempty}
-
--- |  Forget the actor (i.e. replace it with @mempty@).
-rforget :: Monoid s => RSemidirect x s -> RSemidirect x s
-rforget a = a {ractor = mempty}
-
--- |  Make a semidirect pair whose actee is @mempty@.
-rembedActor :: Monoid x => s -> RSemidirect x s
-rembedActor s = RSemidirect mempty s
-
--- |  Make a semidirect pair whose actor element is @mempty@ .
-rembedActee :: Monoid s => x -> RSemidirect x s
-rembedActee x = RSemidirect x mempty
-
--- | Convert a pair into a semidirect product element
-rfromPair :: (x,s) -> RSemidirect x s
-rfromPair (x,s) = RSemidirect x s
+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Semidirect.Strict+-- Description : Strict semidirect products+-- Copyright   : (c) Alice Rixte 2025+-- License     : BSD 3+-- Maintainer  : alice.rixte@u-bordeaux.fr+-- Stability   : unstable+-- Portability : non-portable (GHC extensions)+--+-- Semidirect products for left and right actions.+--+-- For a lazy version, see @'Data.Semidirect.Lazy'@.+--+-- [Usage :]+--+-- >>> import Data.Semigroup+-- >>> LPair (Sum 1) (Product 2) <> LPair (Sum (3 :: Int)) (Product (4 :: Int))+-- LPair {lactee = Sum {getSum = 7}, lactor = Product {getProduct = 8}}+--+-- [Property checking :]+--+-- There is a @'Semigroup'@ instance for @'LSemidirect'@ (resp. @'RSemidirect'@)+-- only if there is a @'LActSgMorph'@ (resp. @'RActSgMorph'@) instance. For+-- example, @'Sum' Int@ acting on itself is not a semigroup action by morphism+-- and therefore the semidirect product is not associative :+--+-- >>> LPair (Sum 1) (Sum 2) <> LPair (Sum (3 :: Int)) (Sum (4 :: Int))+-- No instance for `LActDistrib (Sum Int) (Sum Int)'+--   arising from a use of `<>'+--+-----------------------------------------------------------------------------++module Data.Semidirect.Strict+       ( LSemidirect (..)+       , lerase+       , lforget+       , lembedActee+       , lembedActor+       , lfromPair+        , RSemidirect (..)+        , rerase+        , rforget+        , rembedActee+        , rembedActor+        , rfromPair+       ) where++import Data.Bifunctor+import Data.Act++-- | A semi-direct product for a left action, where @s@ acts on @x@+--+data LSemidirect x s = LPair+  { lactee :: !x -- ^ The value being acted on+  , lactor :: !s -- ^ The acting element+  }+  deriving (Show, Read, Eq)++instance LActSgMorph x s+  => Semigroup (LSemidirect x s) where+  LPair x s <> LPair x' s' =+    LPair  (x <> (s <>$ x')) (s <> s')++instance LActMnMorph x s => Monoid (LSemidirect x s) where+  mempty = LPair mempty mempty++instance Functor (LSemidirect x) where+  fmap f a = a {lactor = f (lactor a)}++instance Bifunctor LSemidirect where+  first f a = a {lactee = f (lactee a)}+  second = fmap++-- |  Erase the actee (i.e. replace it with @mempty@).+lerase :: Monoid x => LSemidirect x s -> LSemidirect x s+lerase a = a {lactee = mempty}++-- |  Forget the actor (i.e. replace it with @mempty@).+lforget :: Monoid s => LSemidirect x s -> LSemidirect x s+lforget a =a {lactor = mempty}++-- |  Make a semidirect pair whose actee is @mempty@.+lembedActor :: Monoid x => s -> LSemidirect x s+lembedActor s = LPair mempty s++-- |  Make a semidirect pair whose actor is @mempty@.+lembedActee :: Monoid s => x -> LSemidirect x s+lembedActee x = LPair x mempty++-- | Convert a pair into a semidirect product element.+lfromPair :: (x,s) -> LSemidirect x s+lfromPair (x,s) = LPair x s+++------------------------------------------------------------------------------++-- |  A semidirect product for a right action, where @s@ acts on @x@+--+data RSemidirect x s = RPair+  { ractee :: !x -- ^ The value being acted on+  , ractor :: !s -- ^ The acting element+  }+  deriving (Show, Read, Eq)++instance RActSgMorph x s+  => Semigroup (RSemidirect x s) where+  RPair x s <> RPair x' s' =+    RPair  (x <> (x' $<> s)) (s <> s')++instance RActMnMorph x s => Monoid (RSemidirect x s) where+  mempty = RPair mempty mempty++instance Functor (RSemidirect x) where+  fmap f a = a {ractor = f (ractor a)}++instance Bifunctor RSemidirect where+  first f a = a {ractee = f (ractee a)}+  second = fmap++-- |  Erase the actee (i.e. replace it with @mempty@).+rerase :: Monoid x => RSemidirect x s -> RSemidirect x s+rerase a = a {ractee = mempty}++-- |  Forget the actor (i.e. replace it with @mempty@).+rforget :: Monoid s => RSemidirect x s -> RSemidirect x s+rforget a = a {ractor = mempty}++-- |  Make a semidirect pair whose actee is @mempty@.+rembedActor :: Monoid x => s -> RSemidirect x s+rembedActor s = RPair mempty s++-- |  Make a semidirect pair whose actor element is @mempty@ .+rembedActee :: Monoid s => x -> RSemidirect x s+rembedActee x = RPair x mempty++-- | Convert a pair into a semidirect product element+rfromPair :: (x,s) -> RSemidirect x s+rfromPair (x,s) = RPair x s

@@ -1,76 +1,75 @@-{-# LANGUAGE DerivingVia                #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-import Test.Hspec
-import Test.QuickCheck
-
-import Data.Monoid
-import Data.Group
-import Data.Act
-
-import qualified Data.Semidirect.Lazy as Lazy
-import qualified Data.Semidirect.Strict as Strict
-
-newtype Days = Days Int
-        deriving Show
-
-newtype Duration = Duration Days
-  deriving Show
-  deriving (Semigroup, Monoid, Group) via Sum Int
-  deriving (LAct Days, LActSg Days, LActMn Days, LTorsor Days)
-           via (ActSelf' (Sum Int))
-  deriving (RAct Days, RActSg Days, RActMn Days, RTorsor Days)
-           via (ActSelf' (Sum Int))
-
-main :: IO ()
-main = hspec $ do
-  describe "Semidirect" $ do
-    describe "LSemidirect" $ do
-      describe "Lazy" $ do
-        it "Product on Sum Semigroup" $ property $
-          \x s y t ->
-            Lazy.LSemidirect (Sum (x :: Int)) (Product (s :: Int))
-            <> Lazy.LSemidirect (Sum y) (Product t)
-            `shouldBe`
-            Lazy.LSemidirect (Sum (x + s*y)) (Product (s*t))
-        it "Product on Sum Monoid" $
-          mempty `shouldBe`
-            Lazy.LSemidirect (mempty :: Sum Int) (mempty :: Product Int)
-      describe "Strict" $ do
-        it "Product on Sum Semigroup" $ property $
-          \x s y t ->
-            Strict.LSemidirect (Sum (x :: Int)) (Product (s :: Int))
-            <> Strict.LSemidirect (Sum y) (Product t)
-            `shouldBe`
-            Strict.LSemidirect (Sum (x + s*y)) (Product (s*t))
-        it "Product on Sum Monoid" $
-          mempty `shouldBe`
-            Strict.LSemidirect (mempty :: Sum Int) (mempty :: Product Int)
-    describe "RSemidirect" $ do
-      describe "Lazy" $ do
-        it "Product on Sum Semigroup" $ property $
-          \x s y t ->
-            Lazy.RSemidirect (Sum (x :: Int)) (Product (s :: Int))
-            <> Lazy.RSemidirect (Sum y) (Product t)
-            `shouldBe`
-            Lazy.RSemidirect (Sum (x + s*y)) (Product (s*t))
-        it "Product on Sum Monoid" $
-          mempty `shouldBe`
-            Lazy.RSemidirect (mempty :: Sum Int) (mempty :: Product Int)
-      describe "Strict" $ do
-        it "Product on Sum Semigroup" $ property $
-          \x s y t ->
-            Strict.RSemidirect (Sum (x :: Int)) (Product (s :: Int))
-            <> Strict.RSemidirect (Sum y) (Product t)
-            `shouldBe`
-            Strict.RSemidirect (Sum (x + s*y)) (Product (s*t))
-        it "Product on Sum Monoid" $
-          mempty `shouldBe`
-            Strict.RSemidirect (mempty :: Sum Int) (mempty :: Product Int)
-
-  describe "Action" $ do
-    describe "ActSelf" $ do
-      it "Int acts on unit" $ property $
-        \x -> (x :: Int) <>$ () `shouldBe` ()
-      it "Unit acts on char" $ property $
-        \x -> () <>$ (x :: Char) `shouldBe` x
+{-# LANGUAGE DerivingVia                #-}++import Test.Hspec+import Test.QuickCheck++import Data.Monoid+import Data.Group+import Data.Act++import qualified Data.Semidirect.Lazy as Lazy+import qualified Data.Semidirect.Strict as Strict++newtype Days = Days Int+        deriving Show++newtype Duration = Duration Days+  deriving Show+  deriving (Semigroup, Monoid, Group) via Sum Int+  deriving (LAct Days, LActSg Days, LActMn Days, LTorsor Days)+           via (ActSelf' (Sum Int))+  deriving (RAct Days, RActSg Days, RActMn Days, RTorsor Days)+           via (ActSelf' (Sum Int))++main :: IO ()+main = hspec $ do+  describe "Semidirect" $ do+    describe "LSemidirect" $ do+      describe "Lazy" $ do+        it "Product on Sum Semigroup" $ property $+          \x s y t ->+            Lazy.LPair (Sum (x :: Int)) (Product (s :: Int))+            <> Lazy.LPair (Sum y) (Product t)+            `shouldBe`+            Lazy.LPair (Sum (x + s*y)) (Product (s*t))+        it "Product on Sum Monoid" $+          mempty `shouldBe`+            Lazy.LPair (mempty :: Sum Int) (mempty :: Product Int)+      describe "Strict" $ do+        it "Product on Sum Semigroup" $ property $+          \x s y t ->+            Strict.LPair (Sum (x :: Int)) (Product (s :: Int))+            <> Strict.LPair (Sum y) (Product t)+            `shouldBe`+            Strict.LPair (Sum (x + s*y)) (Product (s*t))+        it "Product on Sum Monoid" $+          mempty `shouldBe`+            Strict.LPair (mempty :: Sum Int) (mempty :: Product Int)+    describe "RSemidirect" $ do+      describe "Lazy" $ do+        it "Product on Sum Semigroup" $ property $+          \x s y t ->+            Lazy.RPair (Sum (x :: Int)) (Product (s :: Int))+            <> Lazy.RPair (Sum y) (Product t)+            `shouldBe`+            Lazy.RPair (Sum (x + s*y)) (Product (s*t))+        it "Product on Sum Monoid" $+          mempty `shouldBe`+            Lazy.RPair (mempty :: Sum Int) (mempty :: Product Int)+      describe "Strict" $ do+        it "Product on Sum Semigroup" $ property $+          \x s y t ->+            Strict.RPair (Sum (x :: Int)) (Product (s :: Int))+            <> Strict.RPair (Sum y) (Product t)+            `shouldBe`+            Strict.RPair (Sum (x + s*y)) (Product (s*t))+        it "Product on Sum Monoid" $+          mempty `shouldBe`+            Strict.RPair (mempty :: Sum Int) (mempty :: Product Int)++  describe "Action" $ do+    describe "ActSelf" $ do+      it "Int acts on unit" $ property $+        \x -> (x :: Int) <>$ () `shouldBe` ()+      it "Unit acts on char" $ property $+        \x -> () <>$ (x :: Char) `shouldBe` x