1
1
mirror of https://github.com/coot/free-category.git synced 2024-08-16 09:30:46 +03:00

Fixed typos & haddock style

This commit is contained in:
Marcin Szamotulski 2022-09-07 12:33:48 +02:00
parent c7e44166b2
commit d709536e95
4 changed files with 12 additions and 13 deletions

View File

@ -126,15 +126,15 @@ newtype A f a b
-> r a b
}
-- |
-- Isomorphism from @'Arr'@ to @'A'@, which is a specialisation of
-- | Isomorphism from @'Arr'@ to @'A'@, which is a specialisation of
-- @'hoistFreeH2'@.
--
toA :: Arr f a b -> A f a b
toA = hoistFreeH2
{-# INLINE toA #-}
-- |
-- Inverse of @'fromA'@, which also is a specialisatin of @'hoistFreeH2'@.
-- | Inverse of @'fromA'@, which also is a specialisation of @'hoistFreeH2'@.
--
fromA :: A f a b -> Arr f a b
fromA = hoistFreeH2
{-# INLINE fromA #-}

View File

@ -82,8 +82,7 @@ import Control.Category.Free.Internal
-- CPS style free categories
--
-- |
-- CPS style encoded free category; one can use @'FreeAlgebra2'@ class
-- | CPS style encoded free category; one can use @'FreeAlgebra2'@ class
-- instance:
--
-- > liftFree2 @C :: f a b -> C f a b
@ -101,15 +100,15 @@ composeC :: C f y z -> C f x y -> C f x z
composeC (C g) (C f) = C $ \k -> g k . f k
{-# INLINE [1] composeC #-}
-- |
-- Isomorphism from @'ListTr'@ to @'C'@, which is a specialisation of
-- | Isomorphism from @'ListTr'@ to @'C'@, which is a specialisation of
-- @'hoistFreeH2'@.
--
toC :: ListTr f a b -> C f a b
toC = hoistFreeH2
{-# INLINE toC #-}
-- |
-- Inverse of @'fromC'@, which also is a specialisation of @'hoistFreeH2'@.
-- | Inverse of @'fromC'@, which also is a specialisation of @'hoistFreeH2'@.
--
fromC :: C f a b -> ListTr f a b
fromC = hoistFreeH2
{-# INLINE fromC #-}

View File

@ -53,7 +53,7 @@ import Control.Algebra.Free2 ( AlgebraType0
, Proof (..)
)
-- | Oposite categoy in which arrows from @a@ to @b@ are represented by arrows
-- | Opposite category in which arrows from @a@ to @b@ are represented by arrows
-- from @b@ to @a@ in the original category.
--
newtype Op (f :: k -> k -> Type) (a :: k) (b :: k) = Op { runOp :: f b a }
@ -241,7 +241,7 @@ instance ArrowChoice f => ArrowChoice (ListTr f) where
--
-- | Type aligned real time queues; Based on `Purely Functinal Data Structures`
-- | Type aligned real time queues; Based on `Purely Functional Data Structures`
-- C.Okasaki. This the most reliably behaved implementation of free categories
-- in this package.
--

View File

@ -27,7 +27,7 @@ import Control.Algebra.Free2 (FreeAlgebra2 (..))
import Data.Algebra.Free (AlgebraType, AlgebraType0, Proof (..))
-- | Categories which can lift monadic actions, i.e. effectful categories.
-- | Categories which can lift monadic actions, i.e effectful categories.
--
class Category c => EffectCategory c m | c -> m where
effect :: m (c a b) -> c a b