never executed always true always false

    1 {-# LANGUAGE ConstraintKinds #-}
    2 {-# LANGUAGE FunctionalDependencies #-}
    3 {-# LANGUAGE GADTs #-}
    4 {-# LANGUAGE IncoherentInstances #-}
    5 
    6 {- |
    7 Module      : NITTA.Model.Problems.Endpoint
    8 Description : Isolated processor unit interaction
    9 Copyright   : (c) Aleksandr Penskoi, 2019
   10 License     : BSD3
   11 Maintainer  : aleksandr.penskoi@gmail.com
   12 Stability   : experimental
   13 -}
   14 module NITTA.Model.Problems.Endpoint (
   15     EndpointSt (..),
   16     EndpointProblem (..),
   17     EndpointRole (..),
   18     endpointOptionToDecision,
   19     isSource,
   20     isTarget,
   21     isSubroleOf,
   22     setAt,
   23     updAt,
   24 ) where
   25 
   26 import Data.Aeson (ToJSON)
   27 import Data.Map.Strict qualified as M
   28 import Data.Maybe (fromMaybe)
   29 import Data.Set qualified as S
   30 import Data.String.ToString
   31 import Data.String.Utils qualified as S
   32 import GHC.Generics
   33 import NITTA.Intermediate.Types
   34 import NITTA.Model.Time
   35 import NITTA.Utils.Base
   36 import Numeric.Interval.NonEmpty
   37 
   38 data EndpointSt v tp = EndpointSt
   39     { epRole :: EndpointRole v
   40     -- ^ use processor unit as source or target of data
   41     , epAt :: tp
   42     -- ^ time of operation
   43     }
   44     deriving (Generic)
   45 
   46 instance Variables (EndpointSt v t) v where
   47     variables EndpointSt{epRole} = variables epRole
   48 
   49 instance (ToString v, Time t) => Show (EndpointSt v (TimeConstraint t)) where
   50     show EndpointSt{epRole, epAt} = "?" <> show epRole <> "@(" <> show epAt <> ")"
   51 instance (ToString v, Time t) => Show (EndpointSt v (Interval t)) where
   52     show EndpointSt{epRole, epAt} = "!" <> show epRole <> "@(" <> show epAt <> ")"
   53 
   54 instance Ord v => Patch (EndpointSt v tp) (Changeset v) where
   55     patch diff ep@EndpointSt{epRole} = ep{epRole = patch diff epRole}
   56 
   57 instance (ToJSON v, ToJSON tp) => ToJSON (EndpointSt v tp)
   58 
   59 isSource EndpointSt{epRole = Source{}} = True
   60 isSource _ = False
   61 
   62 isTarget EndpointSt{epRole = Target{}} = True
   63 isTarget _ = False
   64 
   65 setAt epAt ep@EndpointSt{} = ep{epAt}
   66 updAt f ep@EndpointSt{epAt} = ep{epAt = f epAt}
   67 
   68 class EndpointProblem u v t | u -> v t where
   69     endpointOptions :: u -> [EndpointSt v (TimeConstraint t)]
   70     endpointDecision :: u -> EndpointSt v (Interval t) -> u
   71 
   72 data EndpointRole v
   73     = -- | get data from PU
   74       Source (S.Set v)
   75     | -- | put data to PU
   76       Target v
   77     deriving (Eq, Ord, Generic)
   78 
   79 instance ToString v => Show (EndpointRole v) where
   80     show (Source vs) = "Source " <> S.join "," (vsToStringList vs)
   81     show (Target v) = "Target " <> toString v
   82 
   83 instance Ord v => Patch (EndpointRole v) (Changeset v) where
   84     patch Changeset{changeI} (Target v) = Target $ fromMaybe v $ changeI M.!? v
   85     patch Changeset{changeO} (Source vs) =
   86         Source $ S.unions $ map (\v -> fromMaybe (S.singleton v) $ changeO M.!? v) $ S.elems vs
   87 
   88 instance Variables (EndpointRole v) v where
   89     variables (Source vs) = vs
   90     variables (Target v) = S.singleton v
   91 
   92 instance ToJSON v => ToJSON (EndpointRole v)
   93 
   94 isSubroleOf (Target a) (Target b) = a == b
   95 isSubroleOf (Source as) (Source bs) = as `S.isSubsetOf` bs
   96 isSubroleOf _ _ = False
   97 
   98 {- | The simplest way to convert an endpoint synthesis option to a endpoint
   99 decision.
  100 -}
  101 endpointOptionToDecision EndpointSt{epRole, epAt} =
  102     let a = inf $ tcAvailable epAt
  103         -- "-1" - is necessary for reduction transfer time
  104         b = a + inf (tcDuration epAt) - 1
  105      in EndpointSt epRole (a ... b)