free-algebras 0.0.7.0 → 0.0.7.1

raw patch · 12 files changed

+135/−59 lines, 12 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• free-algebras.cabal +3/−20
• src/Control/Algebra/Free.hs +9/−0
• src/Control/Algebra/Free2.hs +3/−0
• src/Control/Monad/Action.hs +5/−0
• src/Data/Algebra/Free.hs +11/−2
• src/Data/Algebra/Pointed.hs +2/−0
• src/Data/Group/Free.hs +45/−21
• src/Data/Monoid/Abelian.hs +3/−1
• src/Data/Semigroup/Abelian.hs +2/−0
• src/Data/Semigroup/SemiLattice.hs +2/−0
• test/Test/Data/Group/Free.hs +45/−15

@@ -1,5 +1,10 @@ # Changelog for free-algebras +## Version 0.0.7.1+- `Data.Group.Free.normalize` and `Data.Group.Free.normalizeL` are not both+  `O(n)`, but the former is implemented using the latter (e.g. transforms+  `DList` to a list).+ ## Version 0.0.7.0 - Poly kinded `Control.Algebra.Free.FreeAlgebra` and   `Control.Algebra.Free2.FreeAlgebra2`

@@ -1,5 +1,5 @@ name:           free-algebras-version:        0.0.7.0+version:        0.0.7.1 synopsis:       Free algebras in Haskell. description:    Universal algebra approach to free algebras including higher kinded algebraic structures like functors, applicative functors or monads. category:       Algebra, Control, Monads@@ -7,7 +7,7 @@ bug-reports:    https://github.com/coot/free-algebras/issues author:         Marcin Szamotulski maintainer:     profunctor@pm.me-copyright:      (c) 2018 Marcin Szamotulski+copyright:      (c) 2018-2019 Marcin Szamotulski license:        MPL-2.0 license-file:   LICENSE build-type:     Simple@@ -15,7 +15,7 @@ extra-source-files:     ChangeLog.md     README.md-tested-with:    GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1+tested-with:    GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3  source-repository head   type: git@@ -36,23 +36,6 @@       Paths_free_algebras   hs-source-dirs:       src-  default-extensions:-      ConstraintKinds-      DataKinds-      DeriveFunctor-      EmptyDataDecls-      FlexibleInstances-      FlexibleContexts-      KindSignatures-      InstanceSigs-      MultiParamTypeClasses-      OverloadedStrings-      PolyKinds-      RankNTypes-      ScopedTypeVariables-      TupleSections-      TypeApplications-      TypeFamilies   build-depends:       base            >= 4.9 && <5     , constraints     >= 0.8 && <0.11.0 

@@ -1,5 +1,14 @@ {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}++-- 'ListT' transformer is depreciated+{-# OPTIONS_GHC -Wno-deprecations       #-}+ module Control.Algebra.Free     ( -- Higher free algebra class       FreeAlgebra1 (..)

@@ -1,4 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE RankNTypes          #-}+ module Control.Algebra.Free2     ( FreeAlgebra2 (..)     , Proof (..)

@@ -1,5 +1,10 @@+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE UndecidableInstances       #-}+ module Control.Monad.Action where  import           Control.Monad (join)

@@ -1,5 +1,14 @@-{-# LANGUAGE CPP   #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE TypeApplications    #-}+ module Data.Algebra.Free     ( -- * Free algebra class       FreeAlgebra (..)

@@ -1,5 +1,7 @@ {-# LANGUAGE CPP                  #-}+{-# LANGUAGE DeriveFunctor        #-} {-# LANGUAGE UndecidableInstances #-}+ module Data.Algebra.Pointed     ( Pointed (..)     , PointedMonoid (..)

@@ -1,4 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP          #-}+{-# LANGUAGE TypeFamilies #-}+ {- |    Free groups @@ -13,6 +15,7 @@     , normalize      , FreeGroupL+    , consL     , fromList     , toList     , normalizeL@@ -59,31 +62,32 @@     FreeGroup as >>= f = FreeGroup $ as >>= runFreeGroup . either f f  -- |--- Normalize a list, i.e. remove adjusten inverses from a word, i.e.--- @ab⁻¹ba⁻¹c = c@+-- Normalize a @Dlist@, i.e. remove adjusten inverses from a word, i.e.+-- @ab⁻¹ba⁻¹c = c@.  Note that this function is implemented using+-- @'normalizeL'@, implemnting it directly on @DList@s would be @O(n^2)@+-- instead of @O(n)@. ----- Complexity: @O(n)@+-- /Complexity:/ @O(n)@ normalize     :: Eq a     => DList (Either a a)     -> DList (Either a a)-normalize = DList.foldr fn DList.empty-    where-    fn a as = case as of-        DList.Nil -> DList.singleton a-        _         ->-            let b  = DList.head as-                bs = DList.tail as-            in case (a, b) of-                (Left x,  Right y) | x == y -> bs-                (Right x, Left y)  | x == y -> bs-                _                           -> DList.cons a as+normalize = DList.fromList . normalizeL . DList.toList  -- |--- Smart constructor which normalizes a list.+-- Smart constructor which normalizes a dlist.+--+-- /Complexity:/ @O(n)@ fromDList :: Eq a => DList (Either a a) -> FreeGroup a-fromDList = FreeGroup . normalize+fromDList = freeGroupFromList . DList.toList +-- |+-- Construct a FreeGroup from a list.+--+-- /Complextiy:/ @O(n)@+freeGroupFromList :: Eq a => [Either a a] -> FreeGroup a+freeGroupFromList = FreeGroup . DList.fromList . normalizeL+ toDList :: FreeGroup a -> DList (Either a a) toDList = runFreeGroup @@ -113,20 +117,40 @@     forget = proof  -- |--- Free group in the class of groups which multiplication is strict on the left, i.e.+-- Free group in the class of groups which multiplication is strict on the+-- left, i.e. -- -- prop> undefined <> a = undefined newtype FreeGroupL a = FreeGroupL { runFreeGroupL :: [Either a a] }     deriving (Show, Eq, Ord) +-- | Like @'normalize'@ but for lists.+--+-- /Complexity:/ @O(n)@ normalizeL     :: Eq a     => [Either a a]     -> [Either a a]-normalizeL = DList.toList . normalize . DList.fromList+normalizeL = foldr consL_ [] +-- | Cons a generator (@'Right' x@) or its inverse (@'Left' x@) to the left+-- hand side of a 'FreeGroupL'.+--+-- /Complexity:/ @O(1)@+consL :: Eq a => Either a a -> FreeGroupL a -> FreeGroupL a+consL a (FreeGroupL as) = FreeGroupL (consL_ a as)++consL_ :: Eq a => Either a a -> [Either a a] -> [Either a a]+consL_ a [] = [a]+consL_ a as@(b:bs) = case (a, b) of+    (Left x,  Right y) | x == y -> bs+    (Right x, Left y)  | x == y -> bs+    _                           -> a : as+ -- |--- Smart constructors+-- Smart constructor which normalizes a list.+--+-- /Complexity:/ @O(n)@ fromList :: Eq a => [Either a a] -> FreeGroupL a fromList = FreeGroupL . normalizeL @@ -134,7 +158,7 @@ toList = runFreeGroupL  instance Eq a => Semigroup (FreeGroupL a) where-    FreeGroupL as <> FreeGroupL bs = FreeGroupL $ normalizeL (as ++ bs)+    FreeGroupL as <> FreeGroupL bs = FreeGroupL $ foldr consL_ bs as  instance Eq a => Monoid (FreeGroupL a) where     mempty = FreeGroupL []

@@ -1,4 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP          #-}+{-# LANGUAGE TypeFamilies #-}+ module Data.Monoid.Abelian     ( FreeAbelianMonoid (..)     ) where

@@ -1,3 +1,5 @@+{-# LANGUAGE TypeFamilies #-}+ module Data.Semigroup.Abelian     ( AbelianSemigroup     , FreeAbelianSemigroup

@@ -1,4 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies               #-}+ module Data.Semigroup.SemiLattice     ( FreeSemiLattice     , fromNonEmpty

@@ -3,8 +3,8 @@     ( tests     ) where -import           Control.Monad (mapM) import           Data.Semigroup (Semigroup (..))+import           Data.Bool (bool) import           Data.Group (invert) import           Data.DList (DList) import qualified Data.DList as DList@@ -13,19 +13,16 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -import           Data.Group.Free (fromDList, normalize)+import           Data.Group.Free (fromDList, normalize, fromList, normalizeL) +genList :: Gen a -> Gen [Either a a]+genList gen =+    Gen.list (Range.linear 0 100) gen'+  where+    gen' = Gen.bool >>= bool (Right <$> gen) (Left <$> gen)+ genDList :: Gen a -> Gen (DList (Either a a))-genDList gen = do-    as <- Gen.list (Range.linear 0 100) gen-    DList.fromList <$> mapM-        (\a -> do-            b <- Gen.bool-            if b-            then return $ Right a-            else return $ Left a-        )-        as+genDList gen = DList.fromList <$> genList gen  prop_normalize :: Property prop_normalize = property $ do@@ -33,7 +30,7 @@      normalize (normalize as) === normalize as     normalize (as `DList.append` rev as) === DList.empty-    where+  where     rev :: DList (Either a a) -> DList (Either a a)     rev = DList.foldr (\a as -> DList.snoc as (either Right Left a)) DList.empty @@ -49,14 +46,47 @@ prop_unit = property $ do     fg <- fromDList <$> H.forAll (genDList Gen.bool) -    fg <> mempty       === fg-    mempty <> fg       === fg+    fg <> mempty === fg+    mempty <> fg === fg  prop_associativity :: Property prop_associativity = property $ do     fg   <- fromDList <$> H.forAll (genDList Gen.bool)     fg'  <- fromDList <$> H.forAll (genDList Gen.bool)     fg'' <- fromDList <$> H.forAll (genDList Gen.bool)++    (fg <> fg') <> fg'' === fg <> (fg' <> fg'')++prop_normalizeL :: Property+prop_normalizeL = property $ do+    as <- H.forAll (genList Gen.bool)++    normalizeL (normalizeL as) === normalizeL as+    normalizeL (as ++ rev as) === []+  where+    rev :: [Either a a] -> [Either a a]+    rev = foldl (\as a -> either Right Left a : as) []++prop_invertL :: Property+prop_invertL = property $ do+    fg <- fromList <$> H.forAll (genList Gen.bool)++    invert (invert fg) === fg+    invert fg <> fg    === mempty+    fg <> invert fg    === mempty++prop_unitL :: Property+prop_unitL = property $ do+    fg <- fromList <$> H.forAll (genList Gen.bool)++    fg <> mempty === fg+    mempty <> fg === fg++prop_associativityL :: Property+prop_associativityL = property $ do+    fg   <- fromList <$> H.forAll (genList Gen.bool)+    fg'  <- fromList <$> H.forAll (genList Gen.bool)+    fg'' <- fromList <$> H.forAll (genList Gen.bool)      (fg <> fg') <> fg'' === fg <> (fg' <> fg'')