{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE IncoherentInstances #-}

{- |
Module      : NITTA.Model.Problems.Endpoint
Description : Isolated processor unit interaction
Copyright   : (c) Aleksandr Penskoi, 2019
License     : BSD3
Maintainer  : aleksandr.penskoi@gmail.com
Stability   : experimental
-}
module NITTA.Model.Problems.Endpoint (
    EndpointSt (..),
    EndpointProblem (..),
    EndpointRole (..),
    endpointOptionToDecision,
    isSource,
    isTarget,
    isSubroleOf,
    setAt,
    updAt,
) where

import Data.Aeson (ToJSON)
import Data.Map.Strict qualified as M
import Data.Maybe (fromMaybe)
import Data.Set qualified as S
import Data.String.ToString
import Data.String.Utils qualified as S
import GHC.Generics
import NITTA.Intermediate.Types
import NITTA.Model.Time
import NITTA.Utils.Base
import Numeric.Interval.NonEmpty

data EndpointSt v tp = EndpointSt
    { forall v tp. EndpointSt v tp -> EndpointRole v
epRole :: EndpointRole v
    -- ^ use processor unit as source or target of data
    , forall v tp. EndpointSt v tp -> tp
epAt :: tp
    -- ^ time of operation
    }
    deriving ((forall x. EndpointSt v tp -> Rep (EndpointSt v tp) x)
-> (forall x. Rep (EndpointSt v tp) x -> EndpointSt v tp)
-> Generic (EndpointSt v tp)
forall x. Rep (EndpointSt v tp) x -> EndpointSt v tp
forall x. EndpointSt v tp -> Rep (EndpointSt v tp) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v tp x. Rep (EndpointSt v tp) x -> EndpointSt v tp
forall v tp x. EndpointSt v tp -> Rep (EndpointSt v tp) x
$cfrom :: forall v tp x. EndpointSt v tp -> Rep (EndpointSt v tp) x
from :: forall x. EndpointSt v tp -> Rep (EndpointSt v tp) x
$cto :: forall v tp x. Rep (EndpointSt v tp) x -> EndpointSt v tp
to :: forall x. Rep (EndpointSt v tp) x -> EndpointSt v tp
Generic)

instance Variables (EndpointSt v t) v where
    variables :: EndpointSt v t -> Set v
variables EndpointSt{EndpointRole v
epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole :: EndpointRole v
epRole} = EndpointRole v -> Set v
forall a v. Variables a v => a -> Set v
variables EndpointRole v
epRole

instance (ToString v, Time t) => Show (EndpointSt v (TimeConstraint t)) where
    show :: EndpointSt v (TimeConstraint t) -> String
show EndpointSt{EndpointRole v
epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole :: EndpointRole v
epRole, TimeConstraint t
epAt :: forall v tp. EndpointSt v tp -> tp
epAt :: TimeConstraint t
epAt} = String
"?" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EndpointRole v -> String
forall a. Show a => a -> String
show EndpointRole v
epRole String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"@(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TimeConstraint t -> String
forall a. Show a => a -> String
show TimeConstraint t
epAt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
instance (ToString v, Time t) => Show (EndpointSt v (Interval t)) where
    show :: EndpointSt v (Interval t) -> String
show EndpointSt{EndpointRole v
epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole :: EndpointRole v
epRole, Interval t
epAt :: forall v tp. EndpointSt v tp -> tp
epAt :: Interval t
epAt} = String
"!" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EndpointRole v -> String
forall a. Show a => a -> String
show EndpointRole v
epRole String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"@(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Interval t -> String
forall a. Show a => a -> String
show Interval t
epAt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance Ord v => Patch (EndpointSt v tp) (Changeset v) where
    patch :: Changeset v -> EndpointSt v tp -> EndpointSt v tp
patch Changeset v
diff ep :: EndpointSt v tp
ep@EndpointSt{EndpointRole v
epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole :: EndpointRole v
epRole} = EndpointSt v tp
ep{epRole = patch diff epRole}

instance (ToJSON v, ToJSON tp) => ToJSON (EndpointSt v tp)

isSource :: EndpointSt v tp -> Bool
isSource EndpointSt{epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole = Source{}} = Bool
True
isSource EndpointSt v tp
_ = Bool
False

isTarget :: EndpointSt v tp -> Bool
isTarget EndpointSt{epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole = Target{}} = Bool
True
isTarget EndpointSt v tp
_ = Bool
False

setAt :: tp -> EndpointSt v tp -> EndpointSt v tp
setAt tp
epAt ep :: EndpointSt v tp
ep@EndpointSt{} = EndpointSt v tp
ep{epAt}
updAt :: (t -> tp) -> EndpointSt v t -> EndpointSt v tp
updAt t -> tp
f ep :: EndpointSt v t
ep@EndpointSt{t
epAt :: forall v tp. EndpointSt v tp -> tp
epAt :: t
epAt} = EndpointSt v t
ep{epAt = f epAt}

class EndpointProblem u v t | u -> v t where
    endpointOptions :: u -> [EndpointSt v (TimeConstraint t)]
    endpointDecision :: u -> EndpointSt v (Interval t) -> u

data EndpointRole v
    = -- | get data from PU
      Source (S.Set v)
    | -- | put data to PU
      Target v
    deriving (EndpointRole v -> EndpointRole v -> Bool
(EndpointRole v -> EndpointRole v -> Bool)
-> (EndpointRole v -> EndpointRole v -> Bool)
-> Eq (EndpointRole v)
forall v. Eq v => EndpointRole v -> EndpointRole v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => EndpointRole v -> EndpointRole v -> Bool
== :: EndpointRole v -> EndpointRole v -> Bool
$c/= :: forall v. Eq v => EndpointRole v -> EndpointRole v -> Bool
/= :: EndpointRole v -> EndpointRole v -> Bool
Eq, Eq (EndpointRole v)
Eq (EndpointRole v) =>
(EndpointRole v -> EndpointRole v -> Ordering)
-> (EndpointRole v -> EndpointRole v -> Bool)
-> (EndpointRole v -> EndpointRole v -> Bool)
-> (EndpointRole v -> EndpointRole v -> Bool)
-> (EndpointRole v -> EndpointRole v -> Bool)
-> (EndpointRole v -> EndpointRole v -> EndpointRole v)
-> (EndpointRole v -> EndpointRole v -> EndpointRole v)
-> Ord (EndpointRole v)
EndpointRole v -> EndpointRole v -> Bool
EndpointRole v -> EndpointRole v -> Ordering
EndpointRole v -> EndpointRole v -> EndpointRole v
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 v. Ord v => Eq (EndpointRole v)
forall v. Ord v => EndpointRole v -> EndpointRole v -> Bool
forall v. Ord v => EndpointRole v -> EndpointRole v -> Ordering
forall v.
Ord v =>
EndpointRole v -> EndpointRole v -> EndpointRole v
$ccompare :: forall v. Ord v => EndpointRole v -> EndpointRole v -> Ordering
compare :: EndpointRole v -> EndpointRole v -> Ordering
$c< :: forall v. Ord v => EndpointRole v -> EndpointRole v -> Bool
< :: EndpointRole v -> EndpointRole v -> Bool
$c<= :: forall v. Ord v => EndpointRole v -> EndpointRole v -> Bool
<= :: EndpointRole v -> EndpointRole v -> Bool
$c> :: forall v. Ord v => EndpointRole v -> EndpointRole v -> Bool
> :: EndpointRole v -> EndpointRole v -> Bool
$c>= :: forall v. Ord v => EndpointRole v -> EndpointRole v -> Bool
>= :: EndpointRole v -> EndpointRole v -> Bool
$cmax :: forall v.
Ord v =>
EndpointRole v -> EndpointRole v -> EndpointRole v
max :: EndpointRole v -> EndpointRole v -> EndpointRole v
$cmin :: forall v.
Ord v =>
EndpointRole v -> EndpointRole v -> EndpointRole v
min :: EndpointRole v -> EndpointRole v -> EndpointRole v
Ord, (forall x. EndpointRole v -> Rep (EndpointRole v) x)
-> (forall x. Rep (EndpointRole v) x -> EndpointRole v)
-> Generic (EndpointRole v)
forall x. Rep (EndpointRole v) x -> EndpointRole v
forall x. EndpointRole v -> Rep (EndpointRole v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (EndpointRole v) x -> EndpointRole v
forall v x. EndpointRole v -> Rep (EndpointRole v) x
$cfrom :: forall v x. EndpointRole v -> Rep (EndpointRole v) x
from :: forall x. EndpointRole v -> Rep (EndpointRole v) x
$cto :: forall v x. Rep (EndpointRole v) x -> EndpointRole v
to :: forall x. Rep (EndpointRole v) x -> EndpointRole v
Generic)

instance ToString v => Show (EndpointRole v) where
    show :: EndpointRole v -> String
show (Source Set v
vs) = String
"Source " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
S.join String
"," (Set v -> [String]
forall {a}. ToString a => Set a -> [String]
vsToStringList Set v
vs)
    show (Target v
v) = String
"Target " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> v -> String
forall a. ToString a => a -> String
toString v
v

instance Ord v => Patch (EndpointRole v) (Changeset v) where
    patch :: Changeset v -> EndpointRole v -> EndpointRole v
patch Changeset{Map v v
changeI :: Map v v
changeI :: forall v. Changeset v -> Map v v
changeI} (Target v
v) = v -> EndpointRole v
forall v. v -> EndpointRole v
Target (v -> EndpointRole v) -> v -> EndpointRole v
forall a b. (a -> b) -> a -> b
$ v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
v (Maybe v -> v) -> Maybe v -> v
forall a b. (a -> b) -> a -> b
$ Map v v
changeI Map v v -> v -> Maybe v
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? v
v
    patch Changeset{Map v (Set v)
changeO :: Map v (Set v)
changeO :: forall v. Changeset v -> Map v (Set v)
changeO} (Source Set v
vs) =
        Set v -> EndpointRole v
forall v. Set v -> EndpointRole v
Source (Set v -> EndpointRole v) -> Set v -> EndpointRole v
forall a b. (a -> b) -> a -> b
$ [Set v] -> Set v
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set v] -> Set v) -> [Set v] -> Set v
forall a b. (a -> b) -> a -> b
$ (v -> Set v) -> [v] -> [Set v]
forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> Set v -> Maybe (Set v) -> Set v
forall a. a -> Maybe a -> a
fromMaybe (v -> Set v
forall a. a -> Set a
S.singleton v
v) (Maybe (Set v) -> Set v) -> Maybe (Set v) -> Set v
forall a b. (a -> b) -> a -> b
$ Map v (Set v)
changeO Map v (Set v) -> v -> Maybe (Set v)
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? v
v) ([v] -> [Set v]) -> [v] -> [Set v]
forall a b. (a -> b) -> a -> b
$ Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
vs

instance Variables (EndpointRole v) v where
    variables :: EndpointRole v -> Set v
variables (Source Set v
vs) = Set v
vs
    variables (Target v
v) = v -> Set v
forall a. a -> Set a
S.singleton v
v

instance ToJSON v => ToJSON (EndpointRole v)

isSubroleOf :: EndpointRole a -> EndpointRole a -> Bool
isSubroleOf (Target a
a) (Target a
b) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
isSubroleOf (Source Set a
as) (Source Set a
bs) = Set a
as Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set a
bs
isSubroleOf EndpointRole a
_ EndpointRole a
_ = Bool
False

{- | The simplest way to convert an endpoint synthesis option to a endpoint
decision.
-}
endpointOptionToDecision :: EndpointSt v (TimeConstraint a) -> EndpointSt v (Interval a)
endpointOptionToDecision EndpointSt{EndpointRole v
epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole :: EndpointRole v
epRole, TimeConstraint a
epAt :: forall v tp. EndpointSt v tp -> tp
epAt :: TimeConstraint a
epAt} =
    let a :: a
a = Interval a -> a
forall a. Interval a -> a
inf (Interval a -> a) -> Interval a -> a
forall a b. (a -> b) -> a -> b
$ TimeConstraint a -> Interval a
forall t. TimeConstraint t -> Interval t
tcAvailable TimeConstraint a
epAt
        -- "-1" - is necessary for reduction transfer time
        b :: a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
+ Interval a -> a
forall a. Interval a -> a
inf (TimeConstraint a -> Interval a
forall t. TimeConstraint t -> Interval t
tcDuration TimeConstraint a
epAt) a -> a -> a
forall a. Num a => a -> a -> a
- a
1
     in EndpointRole v -> Interval a -> EndpointSt v (Interval a)
forall v tp. EndpointRole v -> tp -> EndpointSt v tp
EndpointSt EndpointRole v
epRole (a
a a -> a -> Interval a
forall a. Ord a => a -> a -> Interval a
... a
b)