-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Label
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the
-- motivation behind the library, the underlying theory, and implementation details.
--
-- This module provides basic data types and type classes for representing edge
-- labels in edge-labelled graphs, e.g. see "Algebra.Graph.Labelled".
--
-----------------------------------------------------------------------------
module Algebra.Graph.Label (
    -- * Semirings and dioids
    Semiring (..), zero, (<+>), StarSemiring (..), Dioid,

    -- * Data types for edge labels
    NonNegative, finite, finiteWord, unsafeFinite, infinite, getFinite,
    Distance, distance, getDistance, Capacity, capacity, getCapacity,
    Count, count, getCount, PowerSet (..), Minimum, getMinimum, noMinimum,
    Path, Label, isZero, RegularExpression,

    -- * Combining edge labels
    Optimum (..), ShortestPath, AllShortestPaths, CountShortestPaths, WidestPath
    ) where

import Control.Applicative
import Control.Monad
import Data.Coerce
import Data.Maybe
import Data.Monoid (Any (..), Monoid (..), Sum (..))
import Data.Semigroup (Max (..), Min (..))
import Data.Set (Set)
import GHC.Exts (IsList (..))

import Algebra.Graph.Internal

import qualified Data.Set as Set

{-| A /semiring/ extends a commutative 'Monoid' with operation '<.>' that acts
similarly to multiplication over the underlying (additive) monoid and has 'one'
as the identity. This module also provides two convenient aliases: 'zero' for
'mempty', and '<+>' for '<>', which makes the interface more uniform.

Instances of this type class must satisfy the following semiring laws:

    * Associativity of '<+>' and '<.>':

        > x <+> (y <+> z) == (x <+> y) <+> z
        > x <.> (y <.> z) == (x <.> y) <.> z

    * Identities of '<+>' and '<.>':

        > zero <+> x == x == x <+> zero
        >  one <.> x == x == x <.> one

    * Commutativity of '<+>':

        > x <+> y == y <+> x

    * Annihilating 'zero':

        > x <.> zero == zero
        > zero <.> x == zero

    * Distributivity:

        > x <.> (y <+> z) == x <.> y <+> x <.> z
        > (x <+> y) <.> z == x <.> z <+> y <.> z
-}
class (Monoid a, Semigroup a) => Semiring a where
    one   :: a
    (<.>) :: a -> a -> a

{-| A /star semiring/ is a 'Semiring' with an additional unary operator 'star'
satisfying the following two laws:

    > star a = one <+> a <.> star a
    > star a = one <+> star a <.> a
-}
class Semiring a => StarSemiring a where
    star :: a -> a

{-| A /dioid/ is an /idempotent semiring/, i.e. it satisfies the following
/idempotence/ law in addition to the 'Semiring' laws:

    > x <+> x == x
-}
class Semiring a => Dioid a

-- | An alias for 'mempty'.
zero :: Monoid a => a
zero :: a
zero = a
forall a. Monoid a => a
mempty

-- | An alias for '<>'.
(<+>) :: Semigroup a => a -> a -> a
<+> :: a -> a -> a
(<+>) = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

infixr 6 <+>
infixr 7 <.>

instance Semiring Any where
    one :: Any
one             = Bool -> Any
Any Bool
True
    Any Bool
x <.> :: Any -> Any -> Any
<.> Any Bool
y = Bool -> Any
Any (Bool
x Bool -> Bool -> Bool
&& Bool
y)

instance StarSemiring Any where
    star :: Any -> Any
star Any
_ = Bool -> Any
Any Bool
True

instance Dioid Any

-- | A non-negative value that can be 'finite' or 'infinite'. Note: the current
-- implementation of the 'Num' instance raises an error on negative literals
-- and on the 'negate' method.
newtype NonNegative a = NonNegative (Extended a)
    deriving (Functor NonNegative
a -> NonNegative a
Functor NonNegative
-> (forall a. a -> NonNegative a)
-> (forall a b.
    NonNegative (a -> b) -> NonNegative a -> NonNegative b)
-> (forall a b c.
    (a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c)
-> (forall a b. NonNegative a -> NonNegative b -> NonNegative b)
-> (forall a b. NonNegative a -> NonNegative b -> NonNegative a)
-> Applicative NonNegative
NonNegative a -> NonNegative b -> NonNegative b
NonNegative a -> NonNegative b -> NonNegative a
NonNegative (a -> b) -> NonNegative a -> NonNegative b
(a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c
forall a. a -> NonNegative a
forall a b. NonNegative a -> NonNegative b -> NonNegative a
forall a b. NonNegative a -> NonNegative b -> NonNegative b
forall a b. NonNegative (a -> b) -> NonNegative a -> NonNegative b
forall a b c.
(a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: NonNegative a -> NonNegative b -> NonNegative a
$c<* :: forall a b. NonNegative a -> NonNegative b -> NonNegative a
*> :: NonNegative a -> NonNegative b -> NonNegative b
$c*> :: forall a b. NonNegative a -> NonNegative b -> NonNegative b
liftA2 :: (a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c
$cliftA2 :: forall a b c.
(a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c
<*> :: NonNegative (a -> b) -> NonNegative a -> NonNegative b
$c<*> :: forall a b. NonNegative (a -> b) -> NonNegative a -> NonNegative b
pure :: a -> NonNegative a
$cpure :: forall a. a -> NonNegative a
$cp1Applicative :: Functor NonNegative
Applicative, NonNegative a -> NonNegative a -> Bool
(NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool) -> Eq (NonNegative a)
forall a. Eq a => NonNegative a -> NonNegative a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonNegative a -> NonNegative a -> Bool
$c/= :: forall a. Eq a => NonNegative a -> NonNegative a -> Bool
== :: NonNegative a -> NonNegative a -> Bool
$c== :: forall a. Eq a => NonNegative a -> NonNegative a -> Bool
Eq, a -> NonNegative b -> NonNegative a
(a -> b) -> NonNegative a -> NonNegative b
(forall a b. (a -> b) -> NonNegative a -> NonNegative b)
-> (forall a b. a -> NonNegative b -> NonNegative a)
-> Functor NonNegative
forall a b. a -> NonNegative b -> NonNegative a
forall a b. (a -> b) -> NonNegative a -> NonNegative b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NonNegative b -> NonNegative a
$c<$ :: forall a b. a -> NonNegative b -> NonNegative a
fmap :: (a -> b) -> NonNegative a -> NonNegative b
$cfmap :: forall a b. (a -> b) -> NonNegative a -> NonNegative b
Functor, Eq (NonNegative a)
Eq (NonNegative a)
-> (NonNegative a -> NonNegative a -> Ordering)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> Ord (NonNegative a)
NonNegative a -> NonNegative a -> Bool
NonNegative a -> NonNegative a -> Ordering
NonNegative a -> NonNegative a -> NonNegative a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (NonNegative a)
forall a. Ord a => NonNegative a -> NonNegative a -> Bool
forall a. Ord a => NonNegative a -> NonNegative a -> Ordering
forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
min :: NonNegative a -> NonNegative a -> NonNegative a
$cmin :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
max :: NonNegative a -> NonNegative a -> NonNegative a
$cmax :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
>= :: NonNegative a -> NonNegative a -> Bool
$c>= :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
> :: NonNegative a -> NonNegative a -> Bool
$c> :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
<= :: NonNegative a -> NonNegative a -> Bool
$c<= :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
< :: NonNegative a -> NonNegative a -> Bool
$c< :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
compare :: NonNegative a -> NonNegative a -> Ordering
$ccompare :: forall a. Ord a => NonNegative a -> NonNegative a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (NonNegative a)
Ord, Applicative NonNegative
a -> NonNegative a
Applicative NonNegative
-> (forall a b.
    NonNegative a -> (a -> NonNegative b) -> NonNegative b)
-> (forall a b. NonNegative a -> NonNegative b -> NonNegative b)
-> (forall a. a -> NonNegative a)
-> Monad NonNegative
NonNegative a -> (a -> NonNegative b) -> NonNegative b
NonNegative a -> NonNegative b -> NonNegative b
forall a. a -> NonNegative a
forall a b. NonNegative a -> NonNegative b -> NonNegative b
forall a b. NonNegative a -> (a -> NonNegative b) -> NonNegative b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> NonNegative a
$creturn :: forall a. a -> NonNegative a
>> :: NonNegative a -> NonNegative b -> NonNegative b
$c>> :: forall a b. NonNegative a -> NonNegative b -> NonNegative b
>>= :: NonNegative a -> (a -> NonNegative b) -> NonNegative b
$c>>= :: forall a b. NonNegative a -> (a -> NonNegative b) -> NonNegative b
$cp1Monad :: Applicative NonNegative
Monad)

instance (Num a, Show a) => Show (NonNegative a) where
    show :: NonNegative a -> String
show (NonNegative Extended a
Infinite  ) = String
"infinite"
    show (NonNegative (Finite a
x)) = a -> String
forall a. Show a => a -> String
show a
x

instance Num a => Bounded (NonNegative a) where
    minBound :: NonNegative a
minBound = a -> NonNegative a
forall a. a -> NonNegative a
unsafeFinite a
0
    maxBound :: NonNegative a
maxBound = NonNegative a
forall a. NonNegative a
infinite

instance (Num a, Ord a) => Num (NonNegative a) where
    fromInteger :: Integer -> NonNegative a
fromInteger Integer
x | a
f a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = String -> NonNegative a
forall a. HasCallStack => String -> a
error String
"NonNegative values cannot be negative"
                  | Bool
otherwise = a -> NonNegative a
forall a. a -> NonNegative a
unsafeFinite a
f
      where
        f :: a
f = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x

    + :: NonNegative a -> NonNegative a -> NonNegative a
(+) = (Extended a -> Extended a -> Extended a)
-> NonNegative a -> NonNegative a -> NonNegative a
coerce (Extended a -> Extended a -> Extended a
forall a. Num a => a -> a -> a
(+) :: Extended a -> Extended a -> Extended a)
    * :: NonNegative a -> NonNegative a -> NonNegative a
(*) = (Extended a -> Extended a -> Extended a)
-> NonNegative a -> NonNegative a -> NonNegative a
coerce (Extended a -> Extended a -> Extended a
forall a. Num a => a -> a -> a
(*) :: Extended a -> Extended a -> Extended a)

    negate :: NonNegative a -> NonNegative a
negate NonNegative a
_ = String -> NonNegative a
forall a. HasCallStack => String -> a
error String
"NonNegative values cannot be negated"

    signum :: NonNegative a -> NonNegative a
signum (NonNegative Extended a
Infinite) = NonNegative a
1
    signum NonNegative a
x = a -> a
forall a. Num a => a -> a
signum (a -> a) -> NonNegative a -> NonNegative a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonNegative a
x

    abs :: NonNegative a -> NonNegative a
abs = NonNegative a -> NonNegative a
forall a. a -> a
id

-- | A finite non-negative value or @Nothing@ if the argument is negative.
finite :: (Num a, Ord a) => a -> Maybe (NonNegative a)
finite :: a -> Maybe (NonNegative a)
finite a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0      = Maybe (NonNegative a)
forall a. Maybe a
Nothing
         | Bool
otherwise  = NonNegative a -> Maybe (NonNegative a)
forall a. a -> Maybe a
Just (a -> NonNegative a
forall a. a -> NonNegative a
unsafeFinite a
x)

-- | A finite 'Word'.
finiteWord :: Word -> NonNegative Word
finiteWord :: Word -> NonNegative Word
finiteWord = Word -> NonNegative Word
forall a. a -> NonNegative a
unsafeFinite

-- | A non-negative finite value, created /unsafely/: the argument is not
-- checked for being non-negative, so @unsafeFinite (-1)@ compiles just fine.
unsafeFinite :: a -> NonNegative a
unsafeFinite :: a -> NonNegative a
unsafeFinite = Extended a -> NonNegative a
forall a. Extended a -> NonNegative a
NonNegative (Extended a -> NonNegative a)
-> (a -> Extended a) -> a -> NonNegative a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Extended a
forall a. a -> Extended a
Finite

-- | The (non-negative) infinite value.
infinite :: NonNegative a
infinite :: NonNegative a
infinite = Extended a -> NonNegative a
forall a. Extended a -> NonNegative a
NonNegative Extended a
forall a. Extended a
Infinite

-- | Get a finite value or @Nothing@ if the value is infinite.
getFinite :: NonNegative a -> Maybe a
getFinite :: NonNegative a -> Maybe a
getFinite (NonNegative Extended a
x) = Extended a -> Maybe a
forall a. Extended a -> Maybe a
fromExtended Extended a
x

-- | A /capacity/ is a non-negative value that can be 'finite' or 'infinite'.
-- Capacities form a 'Dioid' as follows:
--
-- @
-- 'zero'  = 0
-- 'one'   = 'capacity' 'infinite'
-- ('<+>') = 'max'
-- ('<.>') = 'min'
-- @
newtype Capacity a = Capacity (Max (NonNegative a))
    deriving (Capacity a
Capacity a -> Capacity a -> Bounded (Capacity a)
forall a. a -> a -> Bounded a
forall a. Num a => Capacity a
maxBound :: Capacity a
$cmaxBound :: forall a. Num a => Capacity a
minBound :: Capacity a
$cminBound :: forall a. Num a => Capacity a
Bounded, Capacity a -> Capacity a -> Bool
(Capacity a -> Capacity a -> Bool)
-> (Capacity a -> Capacity a -> Bool) -> Eq (Capacity a)
forall a. Eq a => Capacity a -> Capacity a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Capacity a -> Capacity a -> Bool
$c/= :: forall a. Eq a => Capacity a -> Capacity a -> Bool
== :: Capacity a -> Capacity a -> Bool
$c== :: forall a. Eq a => Capacity a -> Capacity a -> Bool
Eq, Semigroup (Capacity a)
Capacity a
Semigroup (Capacity a)
-> Capacity a
-> (Capacity a -> Capacity a -> Capacity a)
-> ([Capacity a] -> Capacity a)
-> Monoid (Capacity a)
[Capacity a] -> Capacity a
Capacity a -> Capacity a -> Capacity a
forall a. (Ord a, Num a) => Semigroup (Capacity a)
forall a. (Ord a, Num a) => Capacity a
forall a. (Ord a, Num a) => [Capacity a] -> Capacity a
forall a. (Ord a, Num a) => Capacity a -> Capacity a -> Capacity a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Capacity a] -> Capacity a
$cmconcat :: forall a. (Ord a, Num a) => [Capacity a] -> Capacity a
mappend :: Capacity a -> Capacity a -> Capacity a
$cmappend :: forall a. (Ord a, Num a) => Capacity a -> Capacity a -> Capacity a
mempty :: Capacity a
$cmempty :: forall a. (Ord a, Num a) => Capacity a
$cp1Monoid :: forall a. (Ord a, Num a) => Semigroup (Capacity a)
Monoid, Integer -> Capacity a
Capacity a -> Capacity a
Capacity a -> Capacity a -> Capacity a
(Capacity a -> Capacity a -> Capacity a)
-> (Capacity a -> Capacity a -> Capacity a)
-> (Capacity a -> Capacity a -> Capacity a)
-> (Capacity a -> Capacity a)
-> (Capacity a -> Capacity a)
-> (Capacity a -> Capacity a)
-> (Integer -> Capacity a)
-> Num (Capacity a)
forall a. (Num a, Ord a) => Integer -> Capacity a
forall a. (Num a, Ord a) => Capacity a -> Capacity a
forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Capacity a
$cfromInteger :: forall a. (Num a, Ord a) => Integer -> Capacity a
signum :: Capacity a -> Capacity a
$csignum :: forall a. (Num a, Ord a) => Capacity a -> Capacity a
abs :: Capacity a -> Capacity a
$cabs :: forall a. (Num a, Ord a) => Capacity a -> Capacity a
negate :: Capacity a -> Capacity a
$cnegate :: forall a. (Num a, Ord a) => Capacity a -> Capacity a
* :: Capacity a -> Capacity a -> Capacity a
$c* :: forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
- :: Capacity a -> Capacity a -> Capacity a
$c- :: forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
+ :: Capacity a -> Capacity a -> Capacity a
$c+ :: forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
Num, Eq (Capacity a)
Eq (Capacity a)
-> (Capacity a -> Capacity a -> Ordering)
-> (Capacity a -> Capacity a -> Bool)
-> (Capacity a -> Capacity a -> Bool)
-> (Capacity a -> Capacity a -> Bool)
-> (Capacity a -> Capacity a -> Bool)
-> (Capacity a -> Capacity a -> Capacity a)
-> (Capacity a -> Capacity a -> Capacity a)
-> Ord (Capacity a)
Capacity a -> Capacity a -> Bool
Capacity a -> Capacity a -> Ordering
Capacity a -> Capacity a -> Capacity a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Capacity a)
forall a. Ord a => Capacity a -> Capacity a -> Bool
forall a. Ord a => Capacity a -> Capacity a -> Ordering
forall a. Ord a => Capacity a -> Capacity a -> Capacity a
min :: Capacity a -> Capacity a -> Capacity a
$cmin :: forall a. Ord a => Capacity a -> Capacity a -> Capacity a
max :: Capacity a -> Capacity a -> Capacity a
$cmax :: forall a. Ord a => Capacity a -> Capacity a -> Capacity a
>= :: Capacity a -> Capacity a -> Bool
$c>= :: forall a. Ord a => Capacity a -> Capacity a -> Bool
> :: Capacity a -> Capacity a -> Bool
$c> :: forall a. Ord a => Capacity a -> Capacity a -> Bool
<= :: Capacity a -> Capacity a -> Bool
$c<= :: forall a. Ord a => Capacity a -> Capacity a -> Bool
< :: Capacity a -> Capacity a -> Bool
$c< :: forall a. Ord a => Capacity a -> Capacity a -> Bool
compare :: Capacity a -> Capacity a -> Ordering
$ccompare :: forall a. Ord a => Capacity a -> Capacity a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Capacity a)
Ord, b -> Capacity a -> Capacity a
NonEmpty (Capacity a) -> Capacity a
Capacity a -> Capacity a -> Capacity a
(Capacity a -> Capacity a -> Capacity a)
-> (NonEmpty (Capacity a) -> Capacity a)
-> (forall b. Integral b => b -> Capacity a -> Capacity a)
-> Semigroup (Capacity a)
forall b. Integral b => b -> Capacity a -> Capacity a
forall a. Ord a => NonEmpty (Capacity a) -> Capacity a
forall a. Ord a => Capacity a -> Capacity a -> Capacity a
forall a b. (Ord a, Integral b) => b -> Capacity a -> Capacity a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Capacity a -> Capacity a
$cstimes :: forall a b. (Ord a, Integral b) => b -> Capacity a -> Capacity a
sconcat :: NonEmpty (Capacity a) -> Capacity a
$csconcat :: forall a. Ord a => NonEmpty (Capacity a) -> Capacity a
<> :: Capacity a -> Capacity a -> Capacity a
$c<> :: forall a. Ord a => Capacity a -> Capacity a -> Capacity a
Semigroup)

instance Show a => Show (Capacity a) where
    show :: Capacity a -> String
show (Capacity (Max (NonNegative (Finite a
x)))) = a -> String
forall a. Show a => a -> String
show a
x
    show Capacity a
_ = String
"capacity infinite"

instance (Num a, Ord a) => Semiring (Capacity a) where
    one :: Capacity a
one   = NonNegative a -> Capacity a
forall a. NonNegative a -> Capacity a
capacity NonNegative a
forall a. NonNegative a
infinite
    <.> :: Capacity a -> Capacity a -> Capacity a
(<.>) = Capacity a -> Capacity a -> Capacity a
forall a. Ord a => a -> a -> a
min

instance (Num a, Ord a) => StarSemiring (Capacity a) where
    star :: Capacity a -> Capacity a
star Capacity a
_ = Capacity a
forall a. Semiring a => a
one

instance (Num a, Ord a) => Dioid (Capacity a)

-- | A non-negative capacity.
capacity :: NonNegative a -> Capacity a
capacity :: NonNegative a -> Capacity a
capacity = Max (NonNegative a) -> Capacity a
forall a. Max (NonNegative a) -> Capacity a
Capacity (Max (NonNegative a) -> Capacity a)
-> (NonNegative a -> Max (NonNegative a))
-> NonNegative a
-> Capacity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative a -> Max (NonNegative a)
forall a. a -> Max a
Max

-- | Get the value of a capacity.
getCapacity :: Capacity a -> NonNegative a
getCapacity :: Capacity a -> NonNegative a
getCapacity (Capacity (Max NonNegative a
x)) = NonNegative a
x

-- | A /count/ is a non-negative value that can be 'finite' or 'infinite'.
-- Counts form a 'Semiring' as follows:
--
-- @
-- 'zero'  = 0
-- 'one'   = 1
-- ('<+>') = ('+')
-- ('<.>') = ('*')
-- @
newtype Count a = Count (Sum (NonNegative a))
    deriving (Count a
Count a -> Count a -> Bounded (Count a)
forall a. a -> a -> Bounded a
forall a. Num a => Count a
maxBound :: Count a
$cmaxBound :: forall a. Num a => Count a
minBound :: Count a
$cminBound :: forall a. Num a => Count a
Bounded, Count a -> Count a -> Bool
(Count a -> Count a -> Bool)
-> (Count a -> Count a -> Bool) -> Eq (Count a)
forall a. Eq a => Count a -> Count a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count a -> Count a -> Bool
$c/= :: forall a. Eq a => Count a -> Count a -> Bool
== :: Count a -> Count a -> Bool
$c== :: forall a. Eq a => Count a -> Count a -> Bool
Eq, Semigroup (Count a)
Count a
Semigroup (Count a)
-> Count a
-> (Count a -> Count a -> Count a)
-> ([Count a] -> Count a)
-> Monoid (Count a)
[Count a] -> Count a
Count a -> Count a -> Count a
forall a. (Num a, Ord a) => Semigroup (Count a)
forall a. (Num a, Ord a) => Count a
forall a. (Num a, Ord a) => [Count a] -> Count a
forall a. (Num a, Ord a) => Count a -> Count a -> Count a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Count a] -> Count a
$cmconcat :: forall a. (Num a, Ord a) => [Count a] -> Count a
mappend :: Count a -> Count a -> Count a
$cmappend :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
mempty :: Count a
$cmempty :: forall a. (Num a, Ord a) => Count a
$cp1Monoid :: forall a. (Num a, Ord a) => Semigroup (Count a)
Monoid, Integer -> Count a
Count a -> Count a
Count a -> Count a -> Count a
(Count a -> Count a -> Count a)
-> (Count a -> Count a -> Count a)
-> (Count a -> Count a -> Count a)
-> (Count a -> Count a)
-> (Count a -> Count a)
-> (Count a -> Count a)
-> (Integer -> Count a)
-> Num (Count a)
forall a. (Num a, Ord a) => Integer -> Count a
forall a. (Num a, Ord a) => Count a -> Count a
forall a. (Num a, Ord a) => Count a -> Count a -> Count a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Count a
$cfromInteger :: forall a. (Num a, Ord a) => Integer -> Count a
signum :: Count a -> Count a
$csignum :: forall a. (Num a, Ord a) => Count a -> Count a
abs :: Count a -> Count a
$cabs :: forall a. (Num a, Ord a) => Count a -> Count a
negate :: Count a -> Count a
$cnegate :: forall a. (Num a, Ord a) => Count a -> Count a
* :: Count a -> Count a -> Count a
$c* :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
- :: Count a -> Count a -> Count a
$c- :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
+ :: Count a -> Count a -> Count a
$c+ :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
Num, Eq (Count a)
Eq (Count a)
-> (Count a -> Count a -> Ordering)
-> (Count a -> Count a -> Bool)
-> (Count a -> Count a -> Bool)
-> (Count a -> Count a -> Bool)
-> (Count a -> Count a -> Bool)
-> (Count a -> Count a -> Count a)
-> (Count a -> Count a -> Count a)
-> Ord (Count a)
Count a -> Count a -> Bool
Count a -> Count a -> Ordering
Count a -> Count a -> Count a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Count a)
forall a. Ord a => Count a -> Count a -> Bool
forall a. Ord a => Count a -> Count a -> Ordering
forall a. Ord a => Count a -> Count a -> Count a
min :: Count a -> Count a -> Count a
$cmin :: forall a. Ord a => Count a -> Count a -> Count a
max :: Count a -> Count a -> Count a
$cmax :: forall a. Ord a => Count a -> Count a -> Count a
>= :: Count a -> Count a -> Bool
$c>= :: forall a. Ord a => Count a -> Count a -> Bool
> :: Count a -> Count a -> Bool
$c> :: forall a. Ord a => Count a -> Count a -> Bool
<= :: Count a -> Count a -> Bool
$c<= :: forall a. Ord a => Count a -> Count a -> Bool
< :: Count a -> Count a -> Bool
$c< :: forall a. Ord a => Count a -> Count a -> Bool
compare :: Count a -> Count a -> Ordering
$ccompare :: forall a. Ord a => Count a -> Count a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Count a)
Ord, b -> Count a -> Count a
NonEmpty (Count a) -> Count a
Count a -> Count a -> Count a
(Count a -> Count a -> Count a)
-> (NonEmpty (Count a) -> Count a)
-> (forall b. Integral b => b -> Count a -> Count a)
-> Semigroup (Count a)
forall b. Integral b => b -> Count a -> Count a
forall a. (Num a, Ord a) => NonEmpty (Count a) -> Count a
forall a. (Num a, Ord a) => Count a -> Count a -> Count a
forall a b. (Num a, Ord a, Integral b) => b -> Count a -> Count a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Count a -> Count a
$cstimes :: forall a b. (Num a, Ord a, Integral b) => b -> Count a -> Count a
sconcat :: NonEmpty (Count a) -> Count a
$csconcat :: forall a. (Num a, Ord a) => NonEmpty (Count a) -> Count a
<> :: Count a -> Count a -> Count a
$c<> :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
Semigroup)

instance Show a => Show (Count a) where
    show :: Count a -> String
show (Count (Sum (NonNegative (Finite a
x)))) = a -> String
forall a. Show a => a -> String
show a
x
    show Count a
_ = String
"count infinite"

instance (Num a, Ord a) => Semiring (Count a) where
    one :: Count a
one   = Count a
1
    <.> :: Count a -> Count a -> Count a
(<.>) = Count a -> Count a -> Count a
forall a. Num a => a -> a -> a
(*)

instance (Num a, Ord a) => StarSemiring (Count a) where
    star :: Count a -> Count a
star Count a
x | Count a
x Count a -> Count a -> Bool
forall a. Eq a => a -> a -> Bool
== Count a
forall a. Monoid a => a
zero = Count a
forall a. Semiring a => a
one
           | Bool
otherwise = NonNegative a -> Count a
forall a. NonNegative a -> Count a
count NonNegative a
forall a. NonNegative a
infinite

-- | A non-negative count.
count :: NonNegative a -> Count a
count :: NonNegative a -> Count a
count = Sum (NonNegative a) -> Count a
forall a. Sum (NonNegative a) -> Count a
Count (Sum (NonNegative a) -> Count a)
-> (NonNegative a -> Sum (NonNegative a))
-> NonNegative a
-> Count a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative a -> Sum (NonNegative a)
forall a. a -> Sum a
Sum

-- | Get the value of a count.
getCount :: Count a -> NonNegative a
getCount :: Count a -> NonNegative a
getCount (Count (Sum NonNegative a
x)) = NonNegative a
x

-- | A /distance/ is a non-negative value that can be 'finite' or 'infinite'.
-- Distances form a 'Dioid' as follows:
--
-- @
-- 'zero'  = 'distance' 'infinite'
-- 'one'   = 0
-- ('<+>') = 'min'
-- ('<.>') = ('+')
-- @
newtype Distance a = Distance (Min (NonNegative a))
    deriving (Distance a
Distance a -> Distance a -> Bounded (Distance a)
forall a. a -> a -> Bounded a
forall a. Num a => Distance a
maxBound :: Distance a
$cmaxBound :: forall a. Num a => Distance a
minBound :: Distance a
$cminBound :: forall a. Num a => Distance a
Bounded, Distance a -> Distance a -> Bool
(Distance a -> Distance a -> Bool)
-> (Distance a -> Distance a -> Bool) -> Eq (Distance a)
forall a. Eq a => Distance a -> Distance a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Distance a -> Distance a -> Bool
$c/= :: forall a. Eq a => Distance a -> Distance a -> Bool
== :: Distance a -> Distance a -> Bool
$c== :: forall a. Eq a => Distance a -> Distance a -> Bool
Eq, Semigroup (Distance a)
Distance a
Semigroup (Distance a)
-> Distance a
-> (Distance a -> Distance a -> Distance a)
-> ([Distance a] -> Distance a)
-> Monoid (Distance a)
[Distance a] -> Distance a
Distance a -> Distance a -> Distance a
forall a. (Ord a, Num a) => Semigroup (Distance a)
forall a. (Ord a, Num a) => Distance a
forall a. (Ord a, Num a) => [Distance a] -> Distance a
forall a. (Ord a, Num a) => Distance a -> Distance a -> Distance a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Distance a] -> Distance a
$cmconcat :: forall a. (Ord a, Num a) => [Distance a] -> Distance a
mappend :: Distance a -> Distance a -> Distance a
$cmappend :: forall a. (Ord a, Num a) => Distance a -> Distance a -> Distance a
mempty :: Distance a
$cmempty :: forall a. (Ord a, Num a) => Distance a
$cp1Monoid :: forall a. (Ord a, Num a) => Semigroup (Distance a)
Monoid, Integer -> Distance a
Distance a -> Distance a
Distance a -> Distance a -> Distance a
(Distance a -> Distance a -> Distance a)
-> (Distance a -> Distance a -> Distance a)
-> (Distance a -> Distance a -> Distance a)
-> (Distance a -> Distance a)
-> (Distance a -> Distance a)
-> (Distance a -> Distance a)
-> (Integer -> Distance a)
-> Num (Distance a)
forall a. (Num a, Ord a) => Integer -> Distance a
forall a. (Num a, Ord a) => Distance a -> Distance a
forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Distance a
$cfromInteger :: forall a. (Num a, Ord a) => Integer -> Distance a
signum :: Distance a -> Distance a
$csignum :: forall a. (Num a, Ord a) => Distance a -> Distance a
abs :: Distance a -> Distance a
$cabs :: forall a. (Num a, Ord a) => Distance a -> Distance a
negate :: Distance a -> Distance a
$cnegate :: forall a. (Num a, Ord a) => Distance a -> Distance a
* :: Distance a -> Distance a -> Distance a
$c* :: forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
- :: Distance a -> Distance a -> Distance a
$c- :: forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
+ :: Distance a -> Distance a -> Distance a
$c+ :: forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
Num, Eq (Distance a)
Eq (Distance a)
-> (Distance a -> Distance a -> Ordering)
-> (Distance a -> Distance a -> Bool)
-> (Distance a -> Distance a -> Bool)
-> (Distance a -> Distance a -> Bool)
-> (Distance a -> Distance a -> Bool)
-> (Distance a -> Distance a -> Distance a)
-> (Distance a -> Distance a -> Distance a)
-> Ord (Distance a)
Distance a -> Distance a -> Bool
Distance a -> Distance a -> Ordering
Distance a -> Distance a -> Distance a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Distance a)
forall a. Ord a => Distance a -> Distance a -> Bool
forall a. Ord a => Distance a -> Distance a -> Ordering
forall a. Ord a => Distance a -> Distance a -> Distance a
min :: Distance a -> Distance a -> Distance a
$cmin :: forall a. Ord a => Distance a -> Distance a -> Distance a
max :: Distance a -> Distance a -> Distance a
$cmax :: forall a. Ord a => Distance a -> Distance a -> Distance a
>= :: Distance a -> Distance a -> Bool
$c>= :: forall a. Ord a => Distance a -> Distance a -> Bool
> :: Distance a -> Distance a -> Bool
$c> :: forall a. Ord a => Distance a -> Distance a -> Bool
<= :: Distance a -> Distance a -> Bool
$c<= :: forall a. Ord a => Distance a -> Distance a -> Bool
< :: Distance a -> Distance a -> Bool
$c< :: forall a. Ord a => Distance a -> Distance a -> Bool
compare :: Distance a -> Distance a -> Ordering
$ccompare :: forall a. Ord a => Distance a -> Distance a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Distance a)
Ord, b -> Distance a -> Distance a
NonEmpty (Distance a) -> Distance a
Distance a -> Distance a -> Distance a
(Distance a -> Distance a -> Distance a)
-> (NonEmpty (Distance a) -> Distance a)
-> (forall b. Integral b => b -> Distance a -> Distance a)
-> Semigroup (Distance a)
forall b. Integral b => b -> Distance a -> Distance a
forall a. Ord a => NonEmpty (Distance a) -> Distance a
forall a. Ord a => Distance a -> Distance a -> Distance a
forall a b. (Ord a, Integral b) => b -> Distance a -> Distance a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Distance a -> Distance a
$cstimes :: forall a b. (Ord a, Integral b) => b -> Distance a -> Distance a
sconcat :: NonEmpty (Distance a) -> Distance a
$csconcat :: forall a. Ord a => NonEmpty (Distance a) -> Distance a
<> :: Distance a -> Distance a -> Distance a
$c<> :: forall a. Ord a => Distance a -> Distance a -> Distance a
Semigroup)

instance Show a => Show (Distance a) where
    show :: Distance a -> String
show (Distance (Min (NonNegative (Finite a
x)))) = a -> String
forall a. Show a => a -> String
show a
x
    show Distance a
_ = String
"distance infinite"

instance (Num a, Ord a) => Semiring (Distance a) where
    one :: Distance a
one   = Distance a
0
    <.> :: Distance a -> Distance a -> Distance a
(<.>) = Distance a -> Distance a -> Distance a
forall a. Num a => a -> a -> a
(+)

instance (Num a, Ord a) => StarSemiring (Distance a) where
    star :: Distance a -> Distance a
star Distance a
_ = Distance a
forall a. Semiring a => a
one

instance (Num a, Ord a) => Dioid (Distance a)

-- | A non-negative distance.
distance :: NonNegative a -> Distance a
distance :: NonNegative a -> Distance a
distance = Min (NonNegative a) -> Distance a
forall a. Min (NonNegative a) -> Distance a
Distance (Min (NonNegative a) -> Distance a)
-> (NonNegative a -> Min (NonNegative a))
-> NonNegative a
-> Distance a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative a -> Min (NonNegative a)
forall a. a -> Min a
Min

-- | Get the value of a distance.
getDistance :: Distance a -> NonNegative a
getDistance :: Distance a -> NonNegative a
getDistance (Distance (Min NonNegative a
x)) = NonNegative a
x

-- This data type extends the underlying type @a@ with a new 'Infinite' value.
data Extended a = Finite a | Infinite
    deriving (Extended a -> Extended a -> Bool
(Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool) -> Eq (Extended a)
forall a. Eq a => Extended a -> Extended a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extended a -> Extended a -> Bool
$c/= :: forall a. Eq a => Extended a -> Extended a -> Bool
== :: Extended a -> Extended a -> Bool
$c== :: forall a. Eq a => Extended a -> Extended a -> Bool
Eq, a -> Extended b -> Extended a
(a -> b) -> Extended a -> Extended b
(forall a b. (a -> b) -> Extended a -> Extended b)
-> (forall a b. a -> Extended b -> Extended a) -> Functor Extended
forall a b. a -> Extended b -> Extended a
forall a b. (a -> b) -> Extended a -> Extended b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Extended b -> Extended a
$c<$ :: forall a b. a -> Extended b -> Extended a
fmap :: (a -> b) -> Extended a -> Extended b
$cfmap :: forall a b. (a -> b) -> Extended a -> Extended b
Functor, Eq (Extended a)
Eq (Extended a)
-> (Extended a -> Extended a -> Ordering)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Extended a)
-> (Extended a -> Extended a -> Extended a)
-> Ord (Extended a)
Extended a -> Extended a -> Bool
Extended a -> Extended a -> Ordering
Extended a -> Extended a -> Extended a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Extended a)
forall a. Ord a => Extended a -> Extended a -> Bool
forall a. Ord a => Extended a -> Extended a -> Ordering
forall a. Ord a => Extended a -> Extended a -> Extended a
min :: Extended a -> Extended a -> Extended a
$cmin :: forall a. Ord a => Extended a -> Extended a -> Extended a
max :: Extended a -> Extended a -> Extended a
$cmax :: forall a. Ord a => Extended a -> Extended a -> Extended a
>= :: Extended a -> Extended a -> Bool
$c>= :: forall a. Ord a => Extended a -> Extended a -> Bool
> :: Extended a -> Extended a -> Bool
$c> :: forall a. Ord a => Extended a -> Extended a -> Bool
<= :: Extended a -> Extended a -> Bool
$c<= :: forall a. Ord a => Extended a -> Extended a -> Bool
< :: Extended a -> Extended a -> Bool
$c< :: forall a. Ord a => Extended a -> Extended a -> Bool
compare :: Extended a -> Extended a -> Ordering
$ccompare :: forall a. Ord a => Extended a -> Extended a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Extended a)
Ord, Int -> Extended a -> ShowS
[Extended a] -> ShowS
Extended a -> String
(Int -> Extended a -> ShowS)
-> (Extended a -> String)
-> ([Extended a] -> ShowS)
-> Show (Extended a)
forall a. Show a => Int -> Extended a -> ShowS
forall a. Show a => [Extended a] -> ShowS
forall a. Show a => Extended a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extended a] -> ShowS
$cshowList :: forall a. Show a => [Extended a] -> ShowS
show :: Extended a -> String
$cshow :: forall a. Show a => Extended a -> String
showsPrec :: Int -> Extended a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Extended a -> ShowS
Show)

instance Applicative Extended where
    pure :: a -> Extended a
pure  = a -> Extended a
forall a. a -> Extended a
Finite
    <*> :: Extended (a -> b) -> Extended a -> Extended b
(<*>) = Extended (a -> b) -> Extended a -> Extended b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Extended where
    return :: a -> Extended a
return = a -> Extended a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    Extended a
Infinite >>= :: Extended a -> (a -> Extended b) -> Extended b
>>= a -> Extended b
_ = Extended b
forall a. Extended a
Infinite
    Finite a
x >>= a -> Extended b
f = a -> Extended b
f a
x

-- Extract the finite value or @Nothing@ if the value is 'Infinite'.
fromExtended :: Extended a -> Maybe a
fromExtended :: Extended a -> Maybe a
fromExtended (Finite a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
fromExtended Extended a
Infinite   = Maybe a
forall a. Maybe a
Nothing

-- A type alias for a binary function on Extended.
instance (Num a, Eq a) => Num (Extended a) where
    fromInteger :: Integer -> Extended a
fromInteger = a -> Extended a
forall a. a -> Extended a
Finite (a -> Extended a) -> (Integer -> a) -> Integer -> Extended a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger

    + :: Extended a -> Extended a -> Extended a
(+) = (a -> a -> a) -> Extended a -> Extended a -> Extended a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)

    Finite a
0 * :: Extended a -> Extended a -> Extended a
* Extended a
_ = a -> Extended a
forall a. a -> Extended a
Finite a
0
    Extended a
_ * Finite a
0 = a -> Extended a
forall a. a -> Extended a
Finite a
0
    Extended a
x * Extended a
y = (a -> a -> a) -> Extended a -> Extended a -> Extended a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*) Extended a
x Extended a
y

    negate :: Extended a -> Extended a
negate = (a -> a) -> Extended a -> Extended a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
    signum :: Extended a -> Extended a
signum = (a -> a) -> Extended a -> Extended a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
    abs :: Extended a -> Extended a
abs    = (a -> a) -> Extended a -> Extended a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs

-- | If @a@ is a monoid, 'Minimum' @a@ forms the following 'Dioid':
--
-- @
-- 'zero'  = 'noMinimum'
-- 'one'   = 'pure' 'mempty'
-- ('<+>') = 'liftA2' 'min'
-- ('<.>') = 'liftA2' 'mappend'
-- @
--
-- To create a singleton value of type 'Minimum' @a@ use the 'pure' function.
-- For example:
--
-- @
-- getMinimum ('pure' "Hello, " '<+>' 'pure' "World!") == Just "Hello, "
-- getMinimum ('pure' "Hello, " '<.>' 'pure' "World!") == Just "Hello, World!"
-- @
newtype Minimum a = Minimum (Extended a)
    deriving (Functor Minimum
a -> Minimum a
Functor Minimum
-> (forall a. a -> Minimum a)
-> (forall a b. Minimum (a -> b) -> Minimum a -> Minimum b)
-> (forall a b c.
    (a -> b -> c) -> Minimum a -> Minimum b -> Minimum c)
-> (forall a b. Minimum a -> Minimum b -> Minimum b)
-> (forall a b. Minimum a -> Minimum b -> Minimum a)
-> Applicative Minimum
Minimum a -> Minimum b -> Minimum b
Minimum a -> Minimum b -> Minimum a
Minimum (a -> b) -> Minimum a -> Minimum b
(a -> b -> c) -> Minimum a -> Minimum b -> Minimum c
forall a. a -> Minimum a
forall a b. Minimum a -> Minimum b -> Minimum a
forall a b. Minimum a -> Minimum b -> Minimum b
forall a b. Minimum (a -> b) -> Minimum a -> Minimum b
forall a b c. (a -> b -> c) -> Minimum a -> Minimum b -> Minimum c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Minimum a -> Minimum b -> Minimum a
$c<* :: forall a b. Minimum a -> Minimum b -> Minimum a
*> :: Minimum a -> Minimum b -> Minimum b
$c*> :: forall a b. Minimum a -> Minimum b -> Minimum b
liftA2 :: (a -> b -> c) -> Minimum a -> Minimum b -> Minimum c
$cliftA2 :: forall a b c. (a -> b -> c) -> Minimum a -> Minimum b -> Minimum c
<*> :: Minimum (a -> b) -> Minimum a -> Minimum b
$c<*> :: forall a b. Minimum (a -> b) -> Minimum a -> Minimum b
pure :: a -> Minimum a
$cpure :: forall a. a -> Minimum a
$cp1Applicative :: Functor Minimum
Applicative, Minimum a -> Minimum a -> Bool
(Minimum a -> Minimum a -> Bool)
-> (Minimum a -> Minimum a -> Bool) -> Eq (Minimum a)
forall a. Eq a => Minimum a -> Minimum a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Minimum a -> Minimum a -> Bool
$c/= :: forall a. Eq a => Minimum a -> Minimum a -> Bool
== :: Minimum a -> Minimum a -> Bool
$c== :: forall a. Eq a => Minimum a -> Minimum a -> Bool
Eq, a -> Minimum b -> Minimum a
(a -> b) -> Minimum a -> Minimum b
(forall a b. (a -> b) -> Minimum a -> Minimum b)
-> (forall a b. a -> Minimum b -> Minimum a) -> Functor Minimum
forall a b. a -> Minimum b -> Minimum a
forall a b. (a -> b) -> Minimum a -> Minimum b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Minimum b -> Minimum a
$c<$ :: forall a b. a -> Minimum b -> Minimum a
fmap :: (a -> b) -> Minimum a -> Minimum b
$cfmap :: forall a b. (a -> b) -> Minimum a -> Minimum b
Functor, Eq (Minimum a)
Eq (Minimum a)
-> (Minimum a -> Minimum a -> Ordering)
-> (Minimum a -> Minimum a -> Bool)
-> (Minimum a -> Minimum a -> Bool)
-> (Minimum a -> Minimum a -> Bool)
-> (Minimum a -> Minimum a -> Bool)
-> (Minimum a -> Minimum a -> Minimum a)
-> (Minimum a -> Minimum a -> Minimum a)
-> Ord (Minimum a)
Minimum a -> Minimum a -> Bool
Minimum a -> Minimum a -> Ordering
Minimum a -> Minimum a -> Minimum a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Minimum a)
forall a. Ord a => Minimum a -> Minimum a -> Bool
forall a. Ord a => Minimum a -> Minimum a -> Ordering
forall a. Ord a => Minimum a -> Minimum a -> Minimum a
min :: Minimum a -> Minimum a -> Minimum a
$cmin :: forall a. Ord a => Minimum a -> Minimum a -> Minimum a
max :: Minimum a -> Minimum a -> Minimum a
$cmax :: forall a. Ord a => Minimum a -> Minimum a -> Minimum a
>= :: Minimum a -> Minimum a -> Bool
$c>= :: forall a. Ord a => Minimum a -> Minimum a -> Bool
> :: Minimum a -> Minimum a -> Bool
$c> :: forall a. Ord a => Minimum a -> Minimum a -> Bool
<= :: Minimum a -> Minimum a -> Bool
$c<= :: forall a. Ord a => Minimum a -> Minimum a -> Bool
< :: Minimum a -> Minimum a -> Bool
$c< :: forall a. Ord a => Minimum a -> Minimum a -> Bool
compare :: Minimum a -> Minimum a -> Ordering
$ccompare :: forall a. Ord a => Minimum a -> Minimum a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Minimum a)
Ord, Applicative Minimum
a -> Minimum a
Applicative Minimum
-> (forall a b. Minimum a -> (a -> Minimum b) -> Minimum b)
-> (forall a b. Minimum a -> Minimum b -> Minimum b)
-> (forall a. a -> Minimum a)
-> Monad Minimum
Minimum a -> (a -> Minimum b) -> Minimum b
Minimum a -> Minimum b -> Minimum b
forall a. a -> Minimum a
forall a b. Minimum a -> Minimum b -> Minimum b
forall a b. Minimum a -> (a -> Minimum b) -> Minimum b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Minimum a
$creturn :: forall a. a -> Minimum a
>> :: Minimum a -> Minimum b -> Minimum b
$c>> :: forall a b. Minimum a -> Minimum b -> Minimum b
>>= :: Minimum a -> (a -> Minimum b) -> Minimum b
$c>>= :: forall a b. Minimum a -> (a -> Minimum b) -> Minimum b
$cp1Monad :: Applicative Minimum
Monad)

-- | Extract the minimum or @Nothing@ if it does not exist.
getMinimum :: Minimum a -> Maybe a
getMinimum :: Minimum a -> Maybe a
getMinimum (Minimum Extended a
x) = Extended a -> Maybe a
forall a. Extended a -> Maybe a
fromExtended Extended a
x

-- | The value corresponding to the lack of minimum, e.g. the minimum of the
-- empty set.
noMinimum :: Minimum a
noMinimum :: Minimum a
noMinimum = Extended a -> Minimum a
forall a. Extended a -> Minimum a
Minimum Extended a
forall a. Extended a
Infinite

instance Ord a => Semigroup (Minimum a) where
    <> :: Minimum a -> Minimum a -> Minimum a
(<>) = Minimum a -> Minimum a -> Minimum a
forall a. Ord a => a -> a -> a
min

instance (Monoid a, Ord a) => Monoid (Minimum a) where
    mempty :: Minimum a
mempty = Minimum a
forall a. Minimum a
noMinimum

instance (Monoid a, Ord a) => Semiring (Minimum a) where
    one :: Minimum a
one   = a -> Minimum a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
    <.> :: Minimum a -> Minimum a -> Minimum a
(<.>) = (a -> a -> a) -> Minimum a -> Minimum a -> Minimum a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend

instance (Monoid a, Ord a) => Dioid (Minimum a)

instance Show a => Show (Minimum a) where
    show :: Minimum a -> String
show (Minimum Extended a
Infinite  ) = String
"one"
    show (Minimum (Finite a
x)) = a -> String
forall a. Show a => a -> String
show a
x

instance IsList a => IsList (Minimum a) where
    type Item (Minimum a) = Item a
    fromList :: [Item (Minimum a)] -> Minimum a
fromList = Extended a -> Minimum a
forall a. Extended a -> Minimum a
Minimum (Extended a -> Minimum a)
-> ([Item a] -> Extended a) -> [Item a] -> Minimum a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Extended a
forall a. a -> Extended a
Finite (a -> Extended a) -> ([Item a] -> a) -> [Item a] -> Extended a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item a] -> a
forall l. IsList l => [Item l] -> l
fromList
    toList :: Minimum a -> [Item (Minimum a)]
toList (Minimum Extended a
x) = a -> [Item a]
forall l. IsList l => l -> [Item l]
toList (a -> [Item a]) -> a -> [Item a]
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. a
errorMessage (Extended a -> Maybe a
forall a. Extended a -> Maybe a
fromExtended Extended a
x)
      where
        errorMessage :: a
errorMessage = String -> a
forall a. HasCallStack => String -> a
error String
"Minimum.toList applied to noMinimum value."

-- | The /power set/ over the underlying set of elements @a@. If @a@ is a
-- monoid, then the power set forms a 'Dioid' as follows:
--
-- @
-- 'zero'    = PowerSet Set.'Set.empty'
-- 'one'     = PowerSet $ Set.'Set.singleton' 'mempty'
-- x '<+>' y = PowerSet $ Set.'Set.union' (getPowerSet x) (getPowerSet y)
-- x '<.>' y = PowerSet $ 'cartesianProductWith' 'mappend' (getPowerSet x) (getPowerSet y)
-- @
newtype PowerSet a = PowerSet { PowerSet a -> Set a
getPowerSet :: Set a }
    deriving (PowerSet a -> PowerSet a -> Bool
(PowerSet a -> PowerSet a -> Bool)
-> (PowerSet a -> PowerSet a -> Bool) -> Eq (PowerSet a)
forall a. Eq a => PowerSet a -> PowerSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PowerSet a -> PowerSet a -> Bool
$c/= :: forall a. Eq a => PowerSet a -> PowerSet a -> Bool
== :: PowerSet a -> PowerSet a -> Bool
$c== :: forall a. Eq a => PowerSet a -> PowerSet a -> Bool
Eq, Semigroup (PowerSet a)
PowerSet a
Semigroup (PowerSet a)
-> PowerSet a
-> (PowerSet a -> PowerSet a -> PowerSet a)
-> ([PowerSet a] -> PowerSet a)
-> Monoid (PowerSet a)
[PowerSet a] -> PowerSet a
PowerSet a -> PowerSet a -> PowerSet a
forall a. Ord a => Semigroup (PowerSet a)
forall a. Ord a => PowerSet a
forall a. Ord a => [PowerSet a] -> PowerSet a
forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PowerSet a] -> PowerSet a
$cmconcat :: forall a. Ord a => [PowerSet a] -> PowerSet a
mappend :: PowerSet a -> PowerSet a -> PowerSet a
$cmappend :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
mempty :: PowerSet a
$cmempty :: forall a. Ord a => PowerSet a
$cp1Monoid :: forall a. Ord a => Semigroup (PowerSet a)
Monoid, Eq (PowerSet a)
Eq (PowerSet a)
-> (PowerSet a -> PowerSet a -> Ordering)
-> (PowerSet a -> PowerSet a -> Bool)
-> (PowerSet a -> PowerSet a -> Bool)
-> (PowerSet a -> PowerSet a -> Bool)
-> (PowerSet a -> PowerSet a -> Bool)
-> (PowerSet a -> PowerSet a -> PowerSet a)
-> (PowerSet a -> PowerSet a -> PowerSet a)
-> Ord (PowerSet a)
PowerSet a -> PowerSet a -> Bool
PowerSet a -> PowerSet a -> Ordering
PowerSet a -> PowerSet a -> PowerSet a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PowerSet a)
forall a. Ord a => PowerSet a -> PowerSet a -> Bool
forall a. Ord a => PowerSet a -> PowerSet a -> Ordering
forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
min :: PowerSet a -> PowerSet a -> PowerSet a
$cmin :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
max :: PowerSet a -> PowerSet a -> PowerSet a
$cmax :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
>= :: PowerSet a -> PowerSet a -> Bool
$c>= :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
> :: PowerSet a -> PowerSet a -> Bool
$c> :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
<= :: PowerSet a -> PowerSet a -> Bool
$c<= :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
< :: PowerSet a -> PowerSet a -> Bool
$c< :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
compare :: PowerSet a -> PowerSet a -> Ordering
$ccompare :: forall a. Ord a => PowerSet a -> PowerSet a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (PowerSet a)
Ord, b -> PowerSet a -> PowerSet a
NonEmpty (PowerSet a) -> PowerSet a
PowerSet a -> PowerSet a -> PowerSet a
(PowerSet a -> PowerSet a -> PowerSet a)
-> (NonEmpty (PowerSet a) -> PowerSet a)
-> (forall b. Integral b => b -> PowerSet a -> PowerSet a)
-> Semigroup (PowerSet a)
forall b. Integral b => b -> PowerSet a -> PowerSet a
forall a. Ord a => NonEmpty (PowerSet a) -> PowerSet a
forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
forall a b. (Ord a, Integral b) => b -> PowerSet a -> PowerSet a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PowerSet a -> PowerSet a
$cstimes :: forall a b. (Ord a, Integral b) => b -> PowerSet a -> PowerSet a
sconcat :: NonEmpty (PowerSet a) -> PowerSet a
$csconcat :: forall a. Ord a => NonEmpty (PowerSet a) -> PowerSet a
<> :: PowerSet a -> PowerSet a -> PowerSet a
$c<> :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
Semigroup, Int -> PowerSet a -> ShowS
[PowerSet a] -> ShowS
PowerSet a -> String
(Int -> PowerSet a -> ShowS)
-> (PowerSet a -> String)
-> ([PowerSet a] -> ShowS)
-> Show (PowerSet a)
forall a. Show a => Int -> PowerSet a -> ShowS
forall a. Show a => [PowerSet a] -> ShowS
forall a. Show a => PowerSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PowerSet a] -> ShowS
$cshowList :: forall a. Show a => [PowerSet a] -> ShowS
show :: PowerSet a -> String
$cshow :: forall a. Show a => PowerSet a -> String
showsPrec :: Int -> PowerSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PowerSet a -> ShowS
Show)

instance (Monoid a, Ord a) => Semiring (PowerSet a) where
    one :: PowerSet a
one                       = Set a -> PowerSet a
forall a. Set a -> PowerSet a
PowerSet (a -> Set a
forall a. a -> Set a
Set.singleton a
forall a. Monoid a => a
mempty)
    PowerSet Set a
x <.> :: PowerSet a -> PowerSet a -> PowerSet a
<.> PowerSet Set a
y = Set a -> PowerSet a
forall a. Set a -> PowerSet a
PowerSet ((a -> a -> a) -> Set a -> Set a -> Set a
forall c a b. Ord c => (a -> b -> c) -> Set a -> Set b -> Set c
cartesianProductWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend Set a
x Set a
y)

instance (Monoid a, Ord a) => Dioid (PowerSet a) where

-- | The type of /free labels/ over the underlying set of symbols @a@. This data
-- type is an instance of classes 'StarSemiring' and 'Dioid'.
data Label a = Zero
             | One
             | Symbol a
             | Label a :+: Label a
             | Label a :*: Label a
             | Star (Label a)
             deriving a -> Label b -> Label a
(a -> b) -> Label a -> Label b
(forall a b. (a -> b) -> Label a -> Label b)
-> (forall a b. a -> Label b -> Label a) -> Functor Label
forall a b. a -> Label b -> Label a
forall a b. (a -> b) -> Label a -> Label b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Label b -> Label a
$c<$ :: forall a b. a -> Label b -> Label a
fmap :: (a -> b) -> Label a -> Label b
$cfmap :: forall a b. (a -> b) -> Label a -> Label b
Functor

infixl 6 :+:
infixl 7 :*:

instance IsList (Label a) where
    type Item (Label a) = a
    fromList :: [Item (Label a)] -> Label a
fromList = (a -> Label a -> Label a) -> Label a -> [a] -> Label a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Label a -> Label a -> Label a
forall a. Semigroup a => a -> a -> a
(<>) (Label a -> Label a -> Label a)
-> (a -> Label a) -> a -> Label a -> Label a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Label a
forall a. a -> Label a
Symbol) Label a
forall a. Label a
Zero
    toList :: Label a -> [Item (Label a)]
toList   = String -> Label a -> [a]
forall a. HasCallStack => String -> a
error String
"Label.toList cannot be given a reasonable definition"

instance Show a => Show (Label a) where
    showsPrec :: Int -> Label a -> ShowS
showsPrec Int
p Label a
label = case Label a
label of
        Label a
Zero     -> Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int
0 :: Int)
        Label a
One      -> Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int
1 :: Int)
        Symbol a
x -> a -> ShowS
forall a. Show a => a -> ShowS
shows a
x
        Label a
x :+: Label a
y  -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Label a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
6 Label a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" | " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Label a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
6 Label a
y
        Label a
x :*: Label a
y  -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
7) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Label a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 Label a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" ; " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Label a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 Label a
y
        Star Label a
x   -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Label a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
8 Label a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"*"   String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Semigroup (Label a) where
    Label a
Zero   <> :: Label a -> Label a -> Label a
<> Label a
x      = Label a
x
    Label a
x      <> Label a
Zero   = Label a
x
    Label a
One    <> Label a
One    = Label a
forall a. Label a
One
    Label a
One    <> Star Label a
x = Label a -> Label a
forall a. Label a -> Label a
Star Label a
x
    Star Label a
x <> Label a
One    = Label a -> Label a
forall a. Label a -> Label a
Star Label a
x
    Label a
x      <> Label a
y      = Label a
x Label a -> Label a -> Label a
forall a. Label a -> Label a -> Label a
:+: Label a
y

instance Monoid (Label a) where
    mempty :: Label a
mempty = Label a
forall a. Label a
Zero

instance Semiring (Label a) where
    one :: Label a
one = Label a
forall a. Label a
One

    Label a
One  <.> :: Label a -> Label a -> Label a
<.> Label a
x    = Label a
x
    Label a
x    <.> Label a
One  = Label a
x
    Label a
Zero <.> Label a
_    = Label a
forall a. Label a
Zero
    Label a
_    <.> Label a
Zero = Label a
forall a. Label a
Zero
    Label a
x    <.> Label a
y    = Label a
x Label a -> Label a -> Label a
forall a. Label a -> Label a -> Label a
:*: Label a
y

instance StarSemiring (Label a) where
    star :: Label a -> Label a
star Label a
Zero     = Label a
forall a. Label a
One
    star Label a
One      = Label a
forall a. Label a
One
    star (Star Label a
x) = Label a -> Label a
forall a. StarSemiring a => a -> a
star Label a
x
    star Label a
x        = Label a -> Label a
forall a. Label a -> Label a
Star Label a
x

-- | Check if a 'Label' is 'zero'.
isZero :: Label a -> Bool
isZero :: Label a -> Bool
isZero Label a
Zero = Bool
True
isZero Label a
_    = Bool
False

-- | A type synonym for /regular expressions/, built on top of /free labels/.
type RegularExpression a = Label a

-- | An /optimum semiring/ obtained by combining a semiring @o@ that defines an
-- /optimisation criterion/, and a semiring @a@ that describes the /arguments/
-- of an optimisation problem. For example, by choosing @o = 'Distance' Int@ and
-- and @a = 'Minimum' ('Path' String)@, we obtain the /shortest path semiring/
-- for computing the shortest path in an @Int@-labelled graph with @String@
-- vertices.
--
-- We assume that the semiring @o@ is /selective/ i.e. for all @x@ and @y@:
--
-- > x <+> y == x || x <+> y == y
--
-- In words, the operation '<+>' always simply selects one of its arguments. For
-- example, the 'Capacity' and 'Distance' semirings are selective, whereas the
-- the 'Count' semiring is not.
data Optimum o a = Optimum { Optimum o a -> o
getOptimum :: o, Optimum o a -> a
getArgument :: a }
    deriving (Optimum o a -> Optimum o a -> Bool
(Optimum o a -> Optimum o a -> Bool)
-> (Optimum o a -> Optimum o a -> Bool) -> Eq (Optimum o a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall o a. (Eq o, Eq a) => Optimum o a -> Optimum o a -> Bool
/= :: Optimum o a -> Optimum o a -> Bool
$c/= :: forall o a. (Eq o, Eq a) => Optimum o a -> Optimum o a -> Bool
== :: Optimum o a -> Optimum o a -> Bool
$c== :: forall o a. (Eq o, Eq a) => Optimum o a -> Optimum o a -> Bool
Eq, Eq (Optimum o a)
Eq (Optimum o a)
-> (Optimum o a -> Optimum o a -> Ordering)
-> (Optimum o a -> Optimum o a -> Bool)
-> (Optimum o a -> Optimum o a -> Bool)
-> (Optimum o a -> Optimum o a -> Bool)
-> (Optimum o a -> Optimum o a -> Bool)
-> (Optimum o a -> Optimum o a -> Optimum o a)
-> (Optimum o a -> Optimum o a -> Optimum o a)
-> Ord (Optimum o a)
Optimum o a -> Optimum o a -> Bool
Optimum o a -> Optimum o a -> Ordering
Optimum o a -> Optimum o a -> Optimum o a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall o a. (Ord o, Ord a) => Eq (Optimum o a)
forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Ordering
forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Optimum o a
min :: Optimum o a -> Optimum o a -> Optimum o a
$cmin :: forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Optimum o a
max :: Optimum o a -> Optimum o a -> Optimum o a
$cmax :: forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Optimum o a
>= :: Optimum o a -> Optimum o a -> Bool
$c>= :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
> :: Optimum o a -> Optimum o a -> Bool
$c> :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
<= :: Optimum o a -> Optimum o a -> Bool
$c<= :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
< :: Optimum o a -> Optimum o a -> Bool
$c< :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
compare :: Optimum o a -> Optimum o a -> Ordering
$ccompare :: forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Ordering
$cp1Ord :: forall o a. (Ord o, Ord a) => Eq (Optimum o a)
Ord, Int -> Optimum o a -> ShowS
[Optimum o a] -> ShowS
Optimum o a -> String
(Int -> Optimum o a -> ShowS)
-> (Optimum o a -> String)
-> ([Optimum o a] -> ShowS)
-> Show (Optimum o a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall o a. (Show o, Show a) => Int -> Optimum o a -> ShowS
forall o a. (Show o, Show a) => [Optimum o a] -> ShowS
forall o a. (Show o, Show a) => Optimum o a -> String
showList :: [Optimum o a] -> ShowS
$cshowList :: forall o a. (Show o, Show a) => [Optimum o a] -> ShowS
show :: Optimum o a -> String
$cshow :: forall o a. (Show o, Show a) => Optimum o a -> String
showsPrec :: Int -> Optimum o a -> ShowS
$cshowsPrec :: forall o a. (Show o, Show a) => Int -> Optimum o a -> ShowS
Show)

-- TODO: Add tests.
-- This is similar to geodetic semirings.
-- See http://vlado.fmf.uni-lj.si/vlado/papers/SemiRingSNA.pdf
instance (Eq o, Monoid a, Monoid o) => Semigroup (Optimum o a) where
    Optimum o
o1 a
a1 <> :: Optimum o a -> Optimum o a -> Optimum o a
<> Optimum o
o2 a
a2
        | o
o1 o -> o -> Bool
forall a. Eq a => a -> a -> Bool
== o
o2  = o -> a -> Optimum o a
forall o a. o -> a -> Optimum o a
Optimum o
o1 (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a1 a
a2)
        | Bool
otherwise = o -> a -> Optimum o a
forall o a. o -> a -> Optimum o a
Optimum o
o a
a
            where
              o :: o
o = o -> o -> o
forall a. Monoid a => a -> a -> a
mappend o
o1 o
o2
              a :: a
a = if o
o o -> o -> Bool
forall a. Eq a => a -> a -> Bool
== o
o1 then a
a1 else a
a2

-- TODO: Add tests.
instance (Eq o, Monoid a, Monoid o) => Monoid (Optimum o a) where
    mempty :: Optimum o a
mempty = o -> a -> Optimum o a
forall o a. o -> a -> Optimum o a
Optimum o
forall a. Monoid a => a
mempty a
forall a. Monoid a => a
mempty

-- TODO: Add tests.
instance (Eq o, Semiring a, Semiring o) => Semiring (Optimum o a) where
    one :: Optimum o a
one = o -> a -> Optimum o a
forall o a. o -> a -> Optimum o a
Optimum o
forall a. Semiring a => a
one a
forall a. Semiring a => a
one
    Optimum o
o1 a
a1 <.> :: Optimum o a -> Optimum o a -> Optimum o a
<.> Optimum o
o2 a
a2 = o -> a -> Optimum o a
forall o a. o -> a -> Optimum o a
Optimum (o
o1 o -> o -> o
forall a. Semiring a => a -> a -> a
<.> o
o2) (a
a1 a -> a -> a
forall a. Semiring a => a -> a -> a
<.> a
a2)

-- TODO: Add tests.
instance (Eq o, StarSemiring a, StarSemiring o) => StarSemiring (Optimum o a) where
    star :: Optimum o a -> Optimum o a
star (Optimum o
o a
a) = o -> a -> Optimum o a
forall o a. o -> a -> Optimum o a
Optimum (o -> o
forall a. StarSemiring a => a -> a
star o
o) (a -> a
forall a. StarSemiring a => a -> a
star a
a)

-- TODO: Add tests.
instance (Eq o, Dioid a, Dioid o) => Dioid (Optimum o a) where

-- | A /path/ is a list of edges.
type Path a = [(a, a)]

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to
-- /finding the lexicographically smallest shortest path/.
type ShortestPath e a = Optimum (Distance e) (Minimum (Path a))

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to /finding all shortest paths/.
type AllShortestPaths e a = Optimum (Distance e) (PowerSet (Path a))

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to /counting all shortest paths/.
type CountShortestPaths e = Optimum (Distance e) (Count Integer)

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to
-- /finding the lexicographically smallest widest path/.
type WidestPath e a = Optimum (Capacity e) (Minimum (Path a))