{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances     #-}

module Data.Semigroup.Action
    ( SAct(..)
    )
    where

import Data.Semigroup (Semigroup, (<>))

-- | Semigroup action.  It should satisfy:
--
-- @
--   x <| s0 <| s1 = x <| s0 <> s1
-- @
class Semigroup s => SAct s x where
    (<|) :: x -> s -> x

-- binds less than '<>'
infixr 5 <|

instance Semigroup s => SAct s s where
    <| :: s -> s -> s
(<|) = s -> s -> s
forall s. Semigroup s => s -> s -> s
(<>)

-- this instance could be generalised to other functors than representable
-- ones (i.e. @y -> x@ for a fixed type @y@).
instance SAct s x => SAct s (y -> x) where
    y -> x
f <| :: (y -> x) -> s -> y -> x
<| s
s = \y
y -> y -> x
f y
y x -> s -> x
forall s x. SAct s x => x -> s -> x
<| s
s