{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wwarn=incomplete-patterns #-}
module Modelling.CdOd.Types (
  AllowedProperties (..),
  AnnotatedCd,
  AnnotatedClassDiagram (..),
  Annotation (..),
  AnyCd,
  AnyClassDiagram (..),
  AnyRelationship,
  Cd,
  CdConstraints (..),
  CdDrawSettings (..),
  CdMutation (..),
  ClassConfig (..),
  ClassDiagram (..),
  DefaultedLimitedLinking (..),
  InvalidRelationship (..),
  LimitedLinking (..),
  Link (..),
  Object (..),
  ObjectConfig (..),
  ObjectDiagram (..),
  ObjectProperties (..),
  Od,
  OmittedDefaultMultiplicities (..),
  Property (..),
  Relationship (..),
  RelationshipMutation (..),
  RelationshipProperties (..),
  WrongRelationshipException (..),
  allCdMutations,
  allowEverything,
  allowNothing,
  anonymiseObjects,
  anyAssociationNames,
  anyRelationshipName,
  anyThickEdge,
  associationNames,
  calculateThickAnyRelationships,
  checkCdConstraints,
  checkCdDrawProperties,
  checkCdDrawSettings,
  checkCdMutations,
  checkClassConfig,
  checkClassConfigAndObjectProperties,
  checkClassConfigWithProperties,
  checkObjectDiagram,
  checkObjectProperties,
  checkOmittedDefaultMultiplicities,
  classNamesOd,
  defaultCdConstraints,
  defaultCdDrawSettings,
  defaultedLimitedLinking,
  defaultOmittedDefaultMultiplicities,
  defaultProperties,
  fromClassDiagram,
  isIllegal,
  isObjectDiagramRandomisable,
  linkLabels,
  maxFiveObjects,
  maxObjects,
  maxRelationships,
  normaliseObjectDiagram,
  rangeWithDefault,
  relationshipName,
  renameClassesAndRelationships,
  renameObjectsWithClassesAndLinksInOd,
  shuffleAnnotatedClassAndConnectionOrder,
  shuffleCdNames,
  shuffleClassAndConnectionOrder,
  shuffleAnyClassAndConnectionOrder,
  shuffleObjectAndLinkOrder,
  sortLimits,
  toPropertySet,
  toValidCd,
  towardsValidProperties,
  unannotateCd,
  -- * Phrasing
  ArticlePreference (..),
  NonInheritancePhrasing (..),
  PhrasingKind (..),
  toArticleToUse,
  toPhrasing,
  ) where


import qualified Data.Bimap                       as BM
import qualified Data.Set                         as S (fromList)

import Modelling.Auxiliary.Common       (lowerFirst)

import Control.Applicative              (Alternative ((<|>)))
import Control.Enumerable               (deriveEnumerable)
import Control.Enumerable.Values        (allValues)
import Control.Exception                (Exception)
import Control.Monad                    (void)
import Control.Monad.Catch              (MonadThrow (throwM))
import Control.Monad.Random             (MonadRandom)
import Control.OutputCapable.Blocks     (ArticleToUse (..))
import Data.Bifunctor                   (Bifunctor (bimap, first, second))
import Data.Bifunctor.TH (
  deriveBifoldable,
  deriveBifunctor,
  deriveBitraversable,
  )
import Data.Bifoldable                  (Bifoldable (bifoldMap))
import Data.Bimap                       (Bimap)
import Data.Bitraversable               (Bitraversable (bitraverse))
import Data.Data                        (Data)
import Data.List                        ((\\), isPrefixOf, sort, stripPrefix)
import Data.List.Extra                  (nubOrd)
import Data.Maybe (
  catMaybes,
  fromJust,
  fromMaybe,
  isJust,
  isNothing,
  mapMaybe,
  )
import Data.Ratio                       (denominator, numerator)
import Data.Set                         (Set)
import Data.String.Interpolate          (iii)
import Data.Tuple.Extra                 (both, dupe)
import Data.Typeable                    (Typeable)
import GHC.Generics                     (Generic)
import System.Random.Shuffle            (shuffleM)

type Od = ObjectDiagram String String String

data Object objectName className
  = Object {
    forall objectName className. Object objectName className -> Bool
isAnonymous               :: !Bool,
    forall objectName className.
Object objectName className -> objectName
objectName                :: objectName,
    forall objectName className.
Object objectName className -> className
objectClass               :: className
    }
  deriving (Object objectName className -> Object objectName className -> Bool
(Object objectName className
 -> Object objectName className -> Bool)
-> (Object objectName className
    -> Object objectName className -> Bool)
-> Eq (Object objectName className)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall objectName className.
(Eq objectName, Eq className) =>
Object objectName className -> Object objectName className -> Bool
$c== :: forall objectName className.
(Eq objectName, Eq className) =>
Object objectName className -> Object objectName className -> Bool
== :: Object objectName className -> Object objectName className -> Bool
$c/= :: forall objectName className.
(Eq objectName, Eq className) =>
Object objectName className -> Object objectName className -> Bool
/= :: Object objectName className -> Object objectName className -> Bool
Eq, (forall a b.
 (a -> b) -> Object objectName a -> Object objectName b)
-> (forall a b. a -> Object objectName b -> Object objectName a)
-> Functor (Object objectName)
forall a b. a -> Object objectName b -> Object objectName a
forall a b. (a -> b) -> Object objectName a -> Object objectName b
forall objectName a b.
a -> Object objectName b -> Object objectName a
forall objectName a b.
(a -> b) -> Object objectName a -> Object objectName b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall objectName a b.
(a -> b) -> Object objectName a -> Object objectName b
fmap :: forall a b. (a -> b) -> Object objectName a -> Object objectName b
$c<$ :: forall objectName a b.
a -> Object objectName b -> Object objectName a
<$ :: forall a b. a -> Object objectName b -> Object objectName a
Functor, (forall x.
 Object objectName className -> Rep (Object objectName className) x)
-> (forall x.
    Rep (Object objectName className) x -> Object objectName className)
-> Generic (Object objectName className)
forall x.
Rep (Object objectName className) x -> Object objectName className
forall x.
Object objectName className -> Rep (Object objectName className) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall objectName className x.
Rep (Object objectName className) x -> Object objectName className
forall objectName className x.
Object objectName className -> Rep (Object objectName className) x
$cfrom :: forall objectName className x.
Object objectName className -> Rep (Object objectName className) x
from :: forall x.
Object objectName className -> Rep (Object objectName className) x
$cto :: forall objectName className x.
Rep (Object objectName className) x -> Object objectName className
to :: forall x.
Rep (Object objectName className) x -> Object objectName className
Generic, Eq (Object objectName className)
Eq (Object objectName className)
-> (Object objectName className
    -> Object objectName className -> Ordering)
-> (Object objectName className
    -> Object objectName className -> Bool)
-> (Object objectName className
    -> Object objectName className -> Bool)
-> (Object objectName className
    -> Object objectName className -> Bool)
-> (Object objectName className
    -> Object objectName className -> Bool)
-> (Object objectName className
    -> Object objectName className -> Object objectName className)
-> (Object objectName className
    -> Object objectName className -> Object objectName className)
-> Ord (Object objectName className)
Object objectName className -> Object objectName className -> Bool
Object objectName className
-> Object objectName className -> Ordering
Object objectName className
-> Object objectName className -> Object objectName className
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 {objectName} {className}.
(Ord objectName, Ord className) =>
Eq (Object objectName className)
forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className -> Object objectName className -> Bool
forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className
-> Object objectName className -> Ordering
forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className
-> Object objectName className -> Object objectName className
$ccompare :: forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className
-> Object objectName className -> Ordering
compare :: Object objectName className
-> Object objectName className -> Ordering
$c< :: forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className -> Object objectName className -> Bool
< :: Object objectName className -> Object objectName className -> Bool
$c<= :: forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className -> Object objectName className -> Bool
<= :: Object objectName className -> Object objectName className -> Bool
$c> :: forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className -> Object objectName className -> Bool
> :: Object objectName className -> Object objectName className -> Bool
$c>= :: forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className -> Object objectName className -> Bool
>= :: Object objectName className -> Object objectName className -> Bool
$cmax :: forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className
-> Object objectName className -> Object objectName className
max :: Object objectName className
-> Object objectName className -> Object objectName className
$cmin :: forall objectName className.
(Ord objectName, Ord className) =>
Object objectName className
-> Object objectName className -> Object objectName className
min :: Object objectName className
-> Object objectName className -> Object objectName className
Ord, ReadPrec [Object objectName className]
ReadPrec (Object objectName className)
Int -> ReadS (Object objectName className)
ReadS [Object objectName className]
(Int -> ReadS (Object objectName className))
-> ReadS [Object objectName className]
-> ReadPrec (Object objectName className)
-> ReadPrec [Object objectName className]
-> Read (Object objectName className)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall objectName className.
(Read objectName, Read className) =>
ReadPrec [Object objectName className]
forall objectName className.
(Read objectName, Read className) =>
ReadPrec (Object objectName className)
forall objectName className.
(Read objectName, Read className) =>
Int -> ReadS (Object objectName className)
forall objectName className.
(Read objectName, Read className) =>
ReadS [Object objectName className]
$creadsPrec :: forall objectName className.
(Read objectName, Read className) =>
Int -> ReadS (Object objectName className)
readsPrec :: Int -> ReadS (Object objectName className)
$creadList :: forall objectName className.
(Read objectName, Read className) =>
ReadS [Object objectName className]
readList :: ReadS [Object objectName className]
$creadPrec :: forall objectName className.
(Read objectName, Read className) =>
ReadPrec (Object objectName className)
readPrec :: ReadPrec (Object objectName className)
$creadListPrec :: forall objectName className.
(Read objectName, Read className) =>
ReadPrec [Object objectName className]
readListPrec :: ReadPrec [Object objectName className]
Read, Int -> Object objectName className -> ShowS
[Object objectName className] -> ShowS
Object objectName className -> String
(Int -> Object objectName className -> ShowS)
-> (Object objectName className -> String)
-> ([Object objectName className] -> ShowS)
-> Show (Object objectName className)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall objectName className.
(Show objectName, Show className) =>
Int -> Object objectName className -> ShowS
forall objectName className.
(Show objectName, Show className) =>
[Object objectName className] -> ShowS
forall objectName className.
(Show objectName, Show className) =>
Object objectName className -> String
$cshowsPrec :: forall objectName className.
(Show objectName, Show className) =>
Int -> Object objectName className -> ShowS
showsPrec :: Int -> Object objectName className -> ShowS
$cshow :: forall objectName className.
(Show objectName, Show className) =>
Object objectName className -> String
show :: Object objectName className -> String
$cshowList :: forall objectName className.
(Show objectName, Show className) =>
[Object objectName className] -> ShowS
showList :: [Object objectName className] -> ShowS
Show)

instance Bifunctor Object where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Object a c -> Object b d
bimap a -> b
f c -> d
g Object {a
c
Bool
isAnonymous :: forall objectName className. Object objectName className -> Bool
objectName :: forall objectName className.
Object objectName className -> objectName
objectClass :: forall objectName className.
Object objectName className -> className
isAnonymous :: Bool
objectName :: a
objectClass :: c
..} = Object {
    isAnonymous :: Bool
isAnonymous     = Bool
isAnonymous,
    objectName :: b
objectName      = a -> b
f a
objectName,
    objectClass :: d
objectClass     = c -> d
g c
objectClass
    }

instance Bifoldable Object where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Object a b -> m
bifoldMap a -> m
f b -> m
g Object {a
b
Bool
isAnonymous :: forall objectName className. Object objectName className -> Bool
objectName :: forall objectName className.
Object objectName className -> objectName
objectClass :: forall objectName className.
Object objectName className -> className
isAnonymous :: Bool
objectName :: a
objectClass :: b
..} = a -> m
f a
objectName
    m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
objectClass

instance Bitraversable Object where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Object a b -> f (Object c d)
bitraverse a -> f c
f b -> f d
g Object {a
b
Bool
isAnonymous :: forall objectName className. Object objectName className -> Bool
objectName :: forall objectName className.
Object objectName className -> objectName
objectClass :: forall objectName className.
Object objectName className -> className
isAnonymous :: Bool
objectName :: a
objectClass :: b
..} = Bool -> c -> d -> Object c d
forall objectName className.
Bool -> objectName -> className -> Object objectName className
Object
    Bool
isAnonymous
    (c -> d -> Object c d) -> f c -> f (d -> Object c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
objectName
    f (d -> Object c d) -> f d -> f (Object c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
objectClass

{-|
A link connects two objects and has a label.
-}
data Link objectName linkLabel
  = Link {
    -- | how the link is labeled, indicating which relationship it belongs to
    forall objectName linkLabel. Link objectName linkLabel -> linkLabel
linkLabel                 :: linkLabel,
    -- | the starting point of the link
    forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkFrom                  :: objectName,
    -- | the end point of the link
    forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkTo                    :: objectName
    }
  deriving (Link objectName linkLabel -> Link objectName linkLabel -> Bool
(Link objectName linkLabel -> Link objectName linkLabel -> Bool)
-> (Link objectName linkLabel -> Link objectName linkLabel -> Bool)
-> Eq (Link objectName linkLabel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall objectName linkLabel.
(Eq linkLabel, Eq objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
$c== :: forall objectName linkLabel.
(Eq linkLabel, Eq objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
== :: Link objectName linkLabel -> Link objectName linkLabel -> Bool
$c/= :: forall objectName linkLabel.
(Eq linkLabel, Eq objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
/= :: Link objectName linkLabel -> Link objectName linkLabel -> Bool
Eq, (forall a b. (a -> b) -> Link objectName a -> Link objectName b)
-> (forall a b. a -> Link objectName b -> Link objectName a)
-> Functor (Link objectName)
forall a b. a -> Link objectName b -> Link objectName a
forall a b. (a -> b) -> Link objectName a -> Link objectName b
forall objectName a b. a -> Link objectName b -> Link objectName a
forall objectName a b.
(a -> b) -> Link objectName a -> Link objectName b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall objectName a b.
(a -> b) -> Link objectName a -> Link objectName b
fmap :: forall a b. (a -> b) -> Link objectName a -> Link objectName b
$c<$ :: forall objectName a b. a -> Link objectName b -> Link objectName a
<$ :: forall a b. a -> Link objectName b -> Link objectName a
Functor, (forall x.
 Link objectName linkLabel -> Rep (Link objectName linkLabel) x)
-> (forall x.
    Rep (Link objectName linkLabel) x -> Link objectName linkLabel)
-> Generic (Link objectName linkLabel)
forall x.
Rep (Link objectName linkLabel) x -> Link objectName linkLabel
forall x.
Link objectName linkLabel -> Rep (Link objectName linkLabel) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall objectName linkLabel x.
Rep (Link objectName linkLabel) x -> Link objectName linkLabel
forall objectName linkLabel x.
Link objectName linkLabel -> Rep (Link objectName linkLabel) x
$cfrom :: forall objectName linkLabel x.
Link objectName linkLabel -> Rep (Link objectName linkLabel) x
from :: forall x.
Link objectName linkLabel -> Rep (Link objectName linkLabel) x
$cto :: forall objectName linkLabel x.
Rep (Link objectName linkLabel) x -> Link objectName linkLabel
to :: forall x.
Rep (Link objectName linkLabel) x -> Link objectName linkLabel
Generic, Eq (Link objectName linkLabel)
Eq (Link objectName linkLabel)
-> (Link objectName linkLabel
    -> Link objectName linkLabel -> Ordering)
-> (Link objectName linkLabel -> Link objectName linkLabel -> Bool)
-> (Link objectName linkLabel -> Link objectName linkLabel -> Bool)
-> (Link objectName linkLabel -> Link objectName linkLabel -> Bool)
-> (Link objectName linkLabel -> Link objectName linkLabel -> Bool)
-> (Link objectName linkLabel
    -> Link objectName linkLabel -> Link objectName linkLabel)
-> (Link objectName linkLabel
    -> Link objectName linkLabel -> Link objectName linkLabel)
-> Ord (Link objectName linkLabel)
Link objectName linkLabel -> Link objectName linkLabel -> Bool
Link objectName linkLabel -> Link objectName linkLabel -> Ordering
Link objectName linkLabel
-> Link objectName linkLabel -> Link objectName linkLabel
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 {objectName} {linkLabel}.
(Ord linkLabel, Ord objectName) =>
Eq (Link objectName linkLabel)
forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Ordering
forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel
-> Link objectName linkLabel -> Link objectName linkLabel
$ccompare :: forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Ordering
compare :: Link objectName linkLabel -> Link objectName linkLabel -> Ordering
$c< :: forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
< :: Link objectName linkLabel -> Link objectName linkLabel -> Bool
$c<= :: forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
<= :: Link objectName linkLabel -> Link objectName linkLabel -> Bool
$c> :: forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
> :: Link objectName linkLabel -> Link objectName linkLabel -> Bool
$c>= :: forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel -> Link objectName linkLabel -> Bool
>= :: Link objectName linkLabel -> Link objectName linkLabel -> Bool
$cmax :: forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel
-> Link objectName linkLabel -> Link objectName linkLabel
max :: Link objectName linkLabel
-> Link objectName linkLabel -> Link objectName linkLabel
$cmin :: forall objectName linkLabel.
(Ord linkLabel, Ord objectName) =>
Link objectName linkLabel
-> Link objectName linkLabel -> Link objectName linkLabel
min :: Link objectName linkLabel
-> Link objectName linkLabel -> Link objectName linkLabel
Ord, ReadPrec [Link objectName linkLabel]
ReadPrec (Link objectName linkLabel)
Int -> ReadS (Link objectName linkLabel)
ReadS [Link objectName linkLabel]
(Int -> ReadS (Link objectName linkLabel))
-> ReadS [Link objectName linkLabel]
-> ReadPrec (Link objectName linkLabel)
-> ReadPrec [Link objectName linkLabel]
-> Read (Link objectName linkLabel)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
ReadPrec [Link objectName linkLabel]
forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
ReadPrec (Link objectName linkLabel)
forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
Int -> ReadS (Link objectName linkLabel)
forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
ReadS [Link objectName linkLabel]
$creadsPrec :: forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
Int -> ReadS (Link objectName linkLabel)
readsPrec :: Int -> ReadS (Link objectName linkLabel)
$creadList :: forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
ReadS [Link objectName linkLabel]
readList :: ReadS [Link objectName linkLabel]
$creadPrec :: forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
ReadPrec (Link objectName linkLabel)
readPrec :: ReadPrec (Link objectName linkLabel)
$creadListPrec :: forall objectName linkLabel.
(Read linkLabel, Read objectName) =>
ReadPrec [Link objectName linkLabel]
readListPrec :: ReadPrec [Link objectName linkLabel]
Read, Int -> Link objectName linkLabel -> ShowS
[Link objectName linkLabel] -> ShowS
Link objectName linkLabel -> String
(Int -> Link objectName linkLabel -> ShowS)
-> (Link objectName linkLabel -> String)
-> ([Link objectName linkLabel] -> ShowS)
-> Show (Link objectName linkLabel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall objectName linkLabel.
(Show linkLabel, Show objectName) =>
Int -> Link objectName linkLabel -> ShowS
forall objectName linkLabel.
(Show linkLabel, Show objectName) =>
[Link objectName linkLabel] -> ShowS
forall objectName linkLabel.
(Show linkLabel, Show objectName) =>
Link objectName linkLabel -> String
$cshowsPrec :: forall objectName linkLabel.
(Show linkLabel, Show objectName) =>
Int -> Link objectName linkLabel -> ShowS
showsPrec :: Int -> Link objectName linkLabel -> ShowS
$cshow :: forall objectName linkLabel.
(Show linkLabel, Show objectName) =>
Link objectName linkLabel -> String
show :: Link objectName linkLabel -> String
$cshowList :: forall objectName linkLabel.
(Show linkLabel, Show objectName) =>
[Link objectName linkLabel] -> ShowS
showList :: [Link objectName linkLabel] -> ShowS
Show)

instance Bifunctor Link where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Link a c -> Link b d
bimap a -> b
f c -> d
g Link {a
c
linkLabel :: forall objectName linkLabel. Link objectName linkLabel -> linkLabel
linkFrom :: forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkTo :: forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkLabel :: c
linkFrom :: a
linkTo :: a
..} = Link {
    linkLabel :: d
linkLabel     = c -> d
g c
linkLabel,
    linkFrom :: b
linkFrom      = a -> b
f a
linkFrom,
    linkTo :: b
linkTo        = a -> b
f a
linkTo
    }

instance Bifoldable Link where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Link a b -> m
bifoldMap a -> m
f b -> m
g Link {a
b
linkLabel :: forall objectName linkLabel. Link objectName linkLabel -> linkLabel
linkFrom :: forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkTo :: forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkLabel :: b
linkFrom :: a
linkTo :: a
..} = b -> m
g b
linkLabel
    m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
linkFrom
    m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
linkTo

instance Bitraversable Link where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Link a b -> f (Link c d)
bitraverse a -> f c
f b -> f d
g Link {a
b
linkLabel :: forall objectName linkLabel. Link objectName linkLabel -> linkLabel
linkFrom :: forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkTo :: forall objectName linkLabel.
Link objectName linkLabel -> objectName
linkLabel :: b
linkFrom :: a
linkTo :: a
..} = d -> c -> c -> Link c d
forall objectName linkLabel.
linkLabel -> objectName -> objectName -> Link objectName linkLabel
Link
    (d -> c -> c -> Link c d) -> f d -> f (c -> c -> Link c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
linkLabel
    f (c -> c -> Link c d) -> f c -> f (c -> Link c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f c
f a
linkFrom
    f (c -> Link c d) -> f c -> f (Link c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f c
f a
linkTo

{-|
The object diagram consists of objects and links between them.

Note, the order of both, links and objects,
might influence its visual appearance when drawn.
-}
data ObjectDiagram objectName className linkLabel
  = ObjectDiagram {
    -- | all objects belonging to the object diagram
    forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
objects                   :: [Object objectName className],
    -- | all links belonging to the object diagram
    forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
links                     :: [Link objectName linkLabel]
    }
  deriving (ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
(ObjectDiagram objectName className linkLabel
 -> ObjectDiagram objectName className linkLabel -> Bool)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel -> Bool)
-> Eq (ObjectDiagram objectName className linkLabel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall objectName className linkLabel.
(Eq objectName, Eq className, Eq linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
$c== :: forall objectName className linkLabel.
(Eq objectName, Eq className, Eq linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
== :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
$c/= :: forall objectName className linkLabel.
(Eq objectName, Eq className, Eq linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
/= :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
Eq, (forall a b.
 (a -> b)
 -> ObjectDiagram objectName className a
 -> ObjectDiagram objectName className b)
-> (forall a b.
    a
    -> ObjectDiagram objectName className b
    -> ObjectDiagram objectName className a)
-> Functor (ObjectDiagram objectName className)
forall a b.
a
-> ObjectDiagram objectName className b
-> ObjectDiagram objectName className a
forall a b.
(a -> b)
-> ObjectDiagram objectName className a
-> ObjectDiagram objectName className b
forall objectName className a b.
a
-> ObjectDiagram objectName className b
-> ObjectDiagram objectName className a
forall objectName className a b.
(a -> b)
-> ObjectDiagram objectName className a
-> ObjectDiagram objectName className b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall objectName className a b.
(a -> b)
-> ObjectDiagram objectName className a
-> ObjectDiagram objectName className b
fmap :: forall a b.
(a -> b)
-> ObjectDiagram objectName className a
-> ObjectDiagram objectName className b
$c<$ :: forall objectName className a b.
a
-> ObjectDiagram objectName className b
-> ObjectDiagram objectName className a
<$ :: forall a b.
a
-> ObjectDiagram objectName className b
-> ObjectDiagram objectName className a
Functor, (forall x.
 ObjectDiagram objectName className linkLabel
 -> Rep (ObjectDiagram objectName className linkLabel) x)
-> (forall x.
    Rep (ObjectDiagram objectName className linkLabel) x
    -> ObjectDiagram objectName className linkLabel)
-> Generic (ObjectDiagram objectName className linkLabel)
forall x.
Rep (ObjectDiagram objectName className linkLabel) x
-> ObjectDiagram objectName className linkLabel
forall x.
ObjectDiagram objectName className linkLabel
-> Rep (ObjectDiagram objectName className linkLabel) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall objectName className linkLabel x.
Rep (ObjectDiagram objectName className linkLabel) x
-> ObjectDiagram objectName className linkLabel
forall objectName className linkLabel x.
ObjectDiagram objectName className linkLabel
-> Rep (ObjectDiagram objectName className linkLabel) x
$cfrom :: forall objectName className linkLabel x.
ObjectDiagram objectName className linkLabel
-> Rep (ObjectDiagram objectName className linkLabel) x
from :: forall x.
ObjectDiagram objectName className linkLabel
-> Rep (ObjectDiagram objectName className linkLabel) x
$cto :: forall objectName className linkLabel x.
Rep (ObjectDiagram objectName className linkLabel) x
-> ObjectDiagram objectName className linkLabel
to :: forall x.
Rep (ObjectDiagram objectName className linkLabel) x
-> ObjectDiagram objectName className linkLabel
Generic, Eq (ObjectDiagram objectName className linkLabel)
Eq (ObjectDiagram objectName className linkLabel)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel -> Ordering)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel -> Bool)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel -> Bool)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel -> Bool)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel -> Bool)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel)
-> (ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel
    -> ObjectDiagram objectName className linkLabel)
-> Ord (ObjectDiagram objectName className linkLabel)
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Ordering
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
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 {objectName} {className} {linkLabel}.
(Ord objectName, Ord className, Ord linkLabel) =>
Eq (ObjectDiagram objectName className linkLabel)
forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Ordering
forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
$ccompare :: forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Ordering
compare :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Ordering
$c< :: forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
< :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
$c<= :: forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
<= :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
$c> :: forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
> :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
$c>= :: forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
>= :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel -> Bool
$cmax :: forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
max :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
$cmin :: forall objectName className linkLabel.
(Ord objectName, Ord className, Ord linkLabel) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
min :: ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
Ord, ReadPrec [ObjectDiagram objectName className linkLabel]
ReadPrec (ObjectDiagram objectName className linkLabel)
Int -> ReadS (ObjectDiagram objectName className linkLabel)
ReadS [ObjectDiagram objectName className linkLabel]
(Int -> ReadS (ObjectDiagram objectName className linkLabel))
-> ReadS [ObjectDiagram objectName className linkLabel]
-> ReadPrec (ObjectDiagram objectName className linkLabel)
-> ReadPrec [ObjectDiagram objectName className linkLabel]
-> Read (ObjectDiagram objectName className linkLabel)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
ReadPrec [ObjectDiagram objectName className linkLabel]
forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
ReadPrec (ObjectDiagram objectName className linkLabel)
forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
Int -> ReadS (ObjectDiagram objectName className linkLabel)
forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
ReadS [ObjectDiagram objectName className linkLabel]
$creadsPrec :: forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
Int -> ReadS (ObjectDiagram objectName className linkLabel)
readsPrec :: Int -> ReadS (ObjectDiagram objectName className linkLabel)
$creadList :: forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
ReadS [ObjectDiagram objectName className linkLabel]
readList :: ReadS [ObjectDiagram objectName className linkLabel]
$creadPrec :: forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
ReadPrec (ObjectDiagram objectName className linkLabel)
readPrec :: ReadPrec (ObjectDiagram objectName className linkLabel)
$creadListPrec :: forall objectName className linkLabel.
(Read objectName, Read className, Read linkLabel) =>
ReadPrec [ObjectDiagram objectName className linkLabel]
readListPrec :: ReadPrec [ObjectDiagram objectName className linkLabel]
Read, Int -> ObjectDiagram objectName className linkLabel -> ShowS
[ObjectDiagram objectName className linkLabel] -> ShowS
ObjectDiagram objectName className linkLabel -> String
(Int -> ObjectDiagram objectName className linkLabel -> ShowS)
-> (ObjectDiagram objectName className linkLabel -> String)
-> ([ObjectDiagram objectName className linkLabel] -> ShowS)
-> Show (ObjectDiagram objectName className linkLabel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall objectName className linkLabel.
(Show objectName, Show className, Show linkLabel) =>
Int -> ObjectDiagram objectName className linkLabel -> ShowS
forall objectName className linkLabel.
(Show objectName, Show className, Show linkLabel) =>
[ObjectDiagram objectName className linkLabel] -> ShowS
forall objectName className linkLabel.
(Show objectName, Show className, Show linkLabel) =>
ObjectDiagram objectName className linkLabel -> String
$cshowsPrec :: forall objectName className linkLabel.
(Show objectName, Show className, Show linkLabel) =>
Int -> ObjectDiagram objectName className linkLabel -> ShowS
showsPrec :: Int -> ObjectDiagram objectName className linkLabel -> ShowS
$cshow :: forall objectName className linkLabel.
(Show objectName, Show className, Show linkLabel) =>
ObjectDiagram objectName className linkLabel -> String
show :: ObjectDiagram objectName className linkLabel -> String
$cshowList :: forall objectName className linkLabel.
(Show objectName, Show className, Show linkLabel) =>
[ObjectDiagram objectName className linkLabel] -> ShowS
showList :: [ObjectDiagram objectName className linkLabel] -> ShowS
Show)

instance Bifunctor (ObjectDiagram a) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> ObjectDiagram a a c -> ObjectDiagram a b d
bimap a -> b
f c -> d
g ObjectDiagram {[Link a c]
[Object a a]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object a a]
links :: [Link a c]
..} = ObjectDiagram {
    objects :: [Object a b]
objects         = (Object a a -> Object a b) -> [Object a a] -> [Object a b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Object a a -> Object a b
forall b c a. (b -> c) -> Object a b -> Object a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second a -> b
f) [Object a a]
objects,
    links :: [Link a d]
links           = (Link a c -> Link a d) -> [Link a c] -> [Link a d]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> d) -> Link a c -> Link a d
forall b c a. (b -> c) -> Link a b -> Link a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second c -> d
g) [Link a c]
links
    }

instance Bifoldable (ObjectDiagram a) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> ObjectDiagram a a b -> m
bifoldMap a -> m
f b -> m
g ObjectDiagram {[Link a b]
[Object a a]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object a a]
links :: [Link a b]
..} = (Object a a -> m) -> [Object a a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (a -> m) -> Object a a -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Object a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
forall a. Monoid a => a
mempty a -> m
f) [Object a a]
objects
    m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Link a b -> m) -> [Link a b] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Link a b -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Link a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
forall a. Monoid a => a
mempty b -> m
g) [Link a b]
links

instance Bitraversable (ObjectDiagram a) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> ObjectDiagram a a b -> f (ObjectDiagram a c d)
bitraverse a -> f c
f b -> f d
g ObjectDiagram {[Link a b]
[Object a a]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object a a]
links :: [Link a b]
..} = [Object a c] -> [Link a d] -> ObjectDiagram a c d
forall objectName className linkLabel.
[Object objectName className]
-> [Link objectName linkLabel]
-> ObjectDiagram objectName className linkLabel
ObjectDiagram
    ([Object a c] -> [Link a d] -> ObjectDiagram a c d)
-> f [Object a c] -> f ([Link a d] -> ObjectDiagram a c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object a a -> f (Object a c)) -> [Object a a] -> f [Object a c]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f a) -> (a -> f c) -> Object a a -> f (Object a c)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Object a b -> f (Object c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> f c
f) [Object a a]
objects
    f ([Link a d] -> ObjectDiagram a c d)
-> f [Link a d] -> f (ObjectDiagram a c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Link a b -> f (Link a d)) -> [Link a b] -> f [Link a d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f a) -> (b -> f d) -> Link a b -> f (Link a d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Link a b -> f (Link c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b -> f d
g) [Link a b]
links

{-|
Sort objects, and links of the 'ObjectDiagram'.
This enables better comparison (especially for test cases).
-}
normaliseObjectDiagram
  :: (Ord className, Ord linkLabel, Ord objectName)
  => ObjectDiagram objectName className linkLabel
  -> ObjectDiagram objectName className linkLabel
normaliseObjectDiagram :: forall className linkLabel objectName.
(Ord className, Ord linkLabel, Ord objectName) =>
ObjectDiagram objectName className linkLabel
-> ObjectDiagram objectName className linkLabel
normaliseObjectDiagram ObjectDiagram {[Link objectName linkLabel]
[Object objectName className]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object objectName className]
links :: [Link objectName linkLabel]
..} = ObjectDiagram {
  objects :: [Object objectName className]
objects = [Object objectName className] -> [Object objectName className]
forall a. Ord a => [a] -> [a]
sort [Object objectName className]
objects,
  links :: [Link objectName linkLabel]
links = [Link objectName linkLabel] -> [Link objectName linkLabel]
forall a. Ord a => [a] -> [a]
sort [Link objectName linkLabel]
links
  }

shuffleObjectAndLinkOrder
  :: MonadRandom m
  => ObjectDiagram objectName className linkLabel
  -> m (ObjectDiagram objectName className linkLabel)
shuffleObjectAndLinkOrder :: forall (m :: * -> *) objectName className linkLabel.
MonadRandom m =>
ObjectDiagram objectName className linkLabel
-> m (ObjectDiagram objectName className linkLabel)
shuffleObjectAndLinkOrder ObjectDiagram {[Link objectName linkLabel]
[Object objectName className]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object objectName className]
links :: [Link objectName linkLabel]
..} = [Object objectName className]
-> [Link objectName linkLabel]
-> ObjectDiagram objectName className linkLabel
forall objectName className linkLabel.
[Object objectName className]
-> [Link objectName linkLabel]
-> ObjectDiagram objectName className linkLabel
ObjectDiagram
  ([Object objectName className]
 -> [Link objectName linkLabel]
 -> ObjectDiagram objectName className linkLabel)
-> m [Object objectName className]
-> m ([Link objectName linkLabel]
      -> ObjectDiagram objectName className linkLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Object objectName className] -> m [Object objectName className]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Object objectName className]
objects
  m ([Link objectName linkLabel]
   -> ObjectDiagram objectName className linkLabel)
-> m [Link objectName linkLabel]
-> m (ObjectDiagram objectName className linkLabel)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Link objectName linkLabel] -> m [Link objectName linkLabel]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Link objectName linkLabel]
links

{-|
The basic mutation operations.
-}
data RelationshipMutation
  = ChangeKind
  | ChangeLimit
  | Flip
  deriving (RelationshipMutation
RelationshipMutation
-> RelationshipMutation -> Bounded RelationshipMutation
forall a. a -> a -> Bounded a
$cminBound :: RelationshipMutation
minBound :: RelationshipMutation
$cmaxBound :: RelationshipMutation
maxBound :: RelationshipMutation
Bounded, Int -> RelationshipMutation
RelationshipMutation -> Int
RelationshipMutation -> [RelationshipMutation]
RelationshipMutation -> RelationshipMutation
RelationshipMutation
-> RelationshipMutation -> [RelationshipMutation]
RelationshipMutation
-> RelationshipMutation
-> RelationshipMutation
-> [RelationshipMutation]
(RelationshipMutation -> RelationshipMutation)
-> (RelationshipMutation -> RelationshipMutation)
-> (Int -> RelationshipMutation)
-> (RelationshipMutation -> Int)
-> (RelationshipMutation -> [RelationshipMutation])
-> (RelationshipMutation
    -> RelationshipMutation -> [RelationshipMutation])
-> (RelationshipMutation
    -> RelationshipMutation -> [RelationshipMutation])
-> (RelationshipMutation
    -> RelationshipMutation
    -> RelationshipMutation
    -> [RelationshipMutation])
-> Enum RelationshipMutation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RelationshipMutation -> RelationshipMutation
succ :: RelationshipMutation -> RelationshipMutation
$cpred :: RelationshipMutation -> RelationshipMutation
pred :: RelationshipMutation -> RelationshipMutation
$ctoEnum :: Int -> RelationshipMutation
toEnum :: Int -> RelationshipMutation
$cfromEnum :: RelationshipMutation -> Int
fromEnum :: RelationshipMutation -> Int
$cenumFrom :: RelationshipMutation -> [RelationshipMutation]
enumFrom :: RelationshipMutation -> [RelationshipMutation]
$cenumFromThen :: RelationshipMutation
-> RelationshipMutation -> [RelationshipMutation]
enumFromThen :: RelationshipMutation
-> RelationshipMutation -> [RelationshipMutation]
$cenumFromTo :: RelationshipMutation
-> RelationshipMutation -> [RelationshipMutation]
enumFromTo :: RelationshipMutation
-> RelationshipMutation -> [RelationshipMutation]
$cenumFromThenTo :: RelationshipMutation
-> RelationshipMutation
-> RelationshipMutation
-> [RelationshipMutation]
enumFromThenTo :: RelationshipMutation
-> RelationshipMutation
-> RelationshipMutation
-> [RelationshipMutation]
Enum, RelationshipMutation -> RelationshipMutation -> Bool
(RelationshipMutation -> RelationshipMutation -> Bool)
-> (RelationshipMutation -> RelationshipMutation -> Bool)
-> Eq RelationshipMutation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationshipMutation -> RelationshipMutation -> Bool
== :: RelationshipMutation -> RelationshipMutation -> Bool
$c/= :: RelationshipMutation -> RelationshipMutation -> Bool
/= :: RelationshipMutation -> RelationshipMutation -> Bool
Eq, (forall x. RelationshipMutation -> Rep RelationshipMutation x)
-> (forall x. Rep RelationshipMutation x -> RelationshipMutation)
-> Generic RelationshipMutation
forall x. Rep RelationshipMutation x -> RelationshipMutation
forall x. RelationshipMutation -> Rep RelationshipMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelationshipMutation -> Rep RelationshipMutation x
from :: forall x. RelationshipMutation -> Rep RelationshipMutation x
$cto :: forall x. Rep RelationshipMutation x -> RelationshipMutation
to :: forall x. Rep RelationshipMutation x -> RelationshipMutation
Generic, Eq RelationshipMutation
Eq RelationshipMutation
-> (RelationshipMutation -> RelationshipMutation -> Ordering)
-> (RelationshipMutation -> RelationshipMutation -> Bool)
-> (RelationshipMutation -> RelationshipMutation -> Bool)
-> (RelationshipMutation -> RelationshipMutation -> Bool)
-> (RelationshipMutation -> RelationshipMutation -> Bool)
-> (RelationshipMutation
    -> RelationshipMutation -> RelationshipMutation)
-> (RelationshipMutation
    -> RelationshipMutation -> RelationshipMutation)
-> Ord RelationshipMutation
RelationshipMutation -> RelationshipMutation -> Bool
RelationshipMutation -> RelationshipMutation -> Ordering
RelationshipMutation
-> RelationshipMutation -> RelationshipMutation
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
$ccompare :: RelationshipMutation -> RelationshipMutation -> Ordering
compare :: RelationshipMutation -> RelationshipMutation -> Ordering
$c< :: RelationshipMutation -> RelationshipMutation -> Bool
< :: RelationshipMutation -> RelationshipMutation -> Bool
$c<= :: RelationshipMutation -> RelationshipMutation -> Bool
<= :: RelationshipMutation -> RelationshipMutation -> Bool
$c> :: RelationshipMutation -> RelationshipMutation -> Bool
> :: RelationshipMutation -> RelationshipMutation -> Bool
$c>= :: RelationshipMutation -> RelationshipMutation -> Bool
>= :: RelationshipMutation -> RelationshipMutation -> Bool
$cmax :: RelationshipMutation
-> RelationshipMutation -> RelationshipMutation
max :: RelationshipMutation
-> RelationshipMutation -> RelationshipMutation
$cmin :: RelationshipMutation
-> RelationshipMutation -> RelationshipMutation
min :: RelationshipMutation
-> RelationshipMutation -> RelationshipMutation
Ord, ReadPrec [RelationshipMutation]
ReadPrec RelationshipMutation
Int -> ReadS RelationshipMutation
ReadS [RelationshipMutation]
(Int -> ReadS RelationshipMutation)
-> ReadS [RelationshipMutation]
-> ReadPrec RelationshipMutation
-> ReadPrec [RelationshipMutation]
-> Read RelationshipMutation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RelationshipMutation
readsPrec :: Int -> ReadS RelationshipMutation
$creadList :: ReadS [RelationshipMutation]
readList :: ReadS [RelationshipMutation]
$creadPrec :: ReadPrec RelationshipMutation
readPrec :: ReadPrec RelationshipMutation
$creadListPrec :: ReadPrec [RelationshipMutation]
readListPrec :: ReadPrec [RelationshipMutation]
Read, Int -> RelationshipMutation -> ShowS
[RelationshipMutation] -> ShowS
RelationshipMutation -> String
(Int -> RelationshipMutation -> ShowS)
-> (RelationshipMutation -> String)
-> ([RelationshipMutation] -> ShowS)
-> Show RelationshipMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationshipMutation -> ShowS
showsPrec :: Int -> RelationshipMutation -> ShowS
$cshow :: RelationshipMutation -> String
show :: RelationshipMutation -> String
$cshowList :: [RelationshipMutation] -> ShowS
showList :: [RelationshipMutation] -> ShowS
Show)

deriveEnumerable ''RelationshipMutation

data CdMutation
  = AddRelationship
  | MutateRelationship !RelationshipMutation
  | RemoveRelationship
  deriving (CdMutation -> CdMutation -> Bool
(CdMutation -> CdMutation -> Bool)
-> (CdMutation -> CdMutation -> Bool) -> Eq CdMutation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CdMutation -> CdMutation -> Bool
== :: CdMutation -> CdMutation -> Bool
$c/= :: CdMutation -> CdMutation -> Bool
/= :: CdMutation -> CdMutation -> Bool
Eq, (forall x. CdMutation -> Rep CdMutation x)
-> (forall x. Rep CdMutation x -> CdMutation) -> Generic CdMutation
forall x. Rep CdMutation x -> CdMutation
forall x. CdMutation -> Rep CdMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CdMutation -> Rep CdMutation x
from :: forall x. CdMutation -> Rep CdMutation x
$cto :: forall x. Rep CdMutation x -> CdMutation
to :: forall x. Rep CdMutation x -> CdMutation
Generic, Eq CdMutation
Eq CdMutation
-> (CdMutation -> CdMutation -> Ordering)
-> (CdMutation -> CdMutation -> Bool)
-> (CdMutation -> CdMutation -> Bool)
-> (CdMutation -> CdMutation -> Bool)
-> (CdMutation -> CdMutation -> Bool)
-> (CdMutation -> CdMutation -> CdMutation)
-> (CdMutation -> CdMutation -> CdMutation)
-> Ord CdMutation
CdMutation -> CdMutation -> Bool
CdMutation -> CdMutation -> Ordering
CdMutation -> CdMutation -> CdMutation
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
$ccompare :: CdMutation -> CdMutation -> Ordering
compare :: CdMutation -> CdMutation -> Ordering
$c< :: CdMutation -> CdMutation -> Bool
< :: CdMutation -> CdMutation -> Bool
$c<= :: CdMutation -> CdMutation -> Bool
<= :: CdMutation -> CdMutation -> Bool
$c> :: CdMutation -> CdMutation -> Bool
> :: CdMutation -> CdMutation -> Bool
$c>= :: CdMutation -> CdMutation -> Bool
>= :: CdMutation -> CdMutation -> Bool
$cmax :: CdMutation -> CdMutation -> CdMutation
max :: CdMutation -> CdMutation -> CdMutation
$cmin :: CdMutation -> CdMutation -> CdMutation
min :: CdMutation -> CdMutation -> CdMutation
Ord, ReadPrec [CdMutation]
ReadPrec CdMutation
Int -> ReadS CdMutation
ReadS [CdMutation]
(Int -> ReadS CdMutation)
-> ReadS [CdMutation]
-> ReadPrec CdMutation
-> ReadPrec [CdMutation]
-> Read CdMutation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CdMutation
readsPrec :: Int -> ReadS CdMutation
$creadList :: ReadS [CdMutation]
readList :: ReadS [CdMutation]
$creadPrec :: ReadPrec CdMutation
readPrec :: ReadPrec CdMutation
$creadListPrec :: ReadPrec [CdMutation]
readListPrec :: ReadPrec [CdMutation]
Read, Int -> CdMutation -> ShowS
[CdMutation] -> ShowS
CdMutation -> String
(Int -> CdMutation -> ShowS)
-> (CdMutation -> String)
-> ([CdMutation] -> ShowS)
-> Show CdMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CdMutation -> ShowS
showsPrec :: Int -> CdMutation -> ShowS
$cshow :: CdMutation -> String
show :: CdMutation -> String
$cshowList :: [CdMutation] -> ShowS
showList :: [CdMutation] -> ShowS
Show)

deriveEnumerable ''CdMutation

allCdMutations :: [CdMutation]
allCdMutations :: [CdMutation]
allCdMutations = [[CdMutation]] -> [CdMutation]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CdMutation]]
forall a. Enumerable a => [[a]]
allValues

checkCdMutations :: [CdMutation] -> Maybe String
checkCdMutations :: [CdMutation] -> Maybe String
checkCdMutations [CdMutation]
mutations
  | [CdMutation] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CdMutation]
mutations
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|At least one CdMutation has to be enabled.|]
  | CdMutation
x:[CdMutation]
_ <- [CdMutation]
mutations [CdMutation] -> [CdMutation] -> [CdMutation]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CdMutation]
allCdMutations
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    There are no duplications allowed for the configured cd mutations
    but #{show x} appears twice.
    |]
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing

{-|
A meta-level connection to a node name
with a (possibly invalid) range of multiplicities
limiting the number of possible (non-meta-level) connections
using this specific connector.
-}
data LimitedLinking nodeName = LimitedLinking {
  forall nodeName. LimitedLinking nodeName -> nodeName
linking                     :: nodeName,
  forall nodeName. LimitedLinking nodeName -> (Int, Maybe Int)
limits                      :: (Int, Maybe Int)
  }
  deriving (Typeable (LimitedLinking nodeName)
Typeable (LimitedLinking nodeName)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> LimitedLinking nodeName
    -> c (LimitedLinking nodeName))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (LimitedLinking nodeName))
-> (LimitedLinking nodeName -> Constr)
-> (LimitedLinking nodeName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (LimitedLinking nodeName)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (LimitedLinking nodeName)))
-> ((forall b. Data b => b -> b)
    -> LimitedLinking nodeName -> LimitedLinking nodeName)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> LimitedLinking nodeName
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> LimitedLinking nodeName
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LimitedLinking nodeName -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> LimitedLinking nodeName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LimitedLinking nodeName -> m (LimitedLinking nodeName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LimitedLinking nodeName -> m (LimitedLinking nodeName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LimitedLinking nodeName -> m (LimitedLinking nodeName))
-> Data (LimitedLinking nodeName)
LimitedLinking nodeName -> Constr
LimitedLinking nodeName -> DataType
(forall b. Data b => b -> b)
-> LimitedLinking nodeName -> LimitedLinking nodeName
forall {nodeName}.
Data nodeName =>
Typeable (LimitedLinking nodeName)
forall nodeName. Data nodeName => LimitedLinking nodeName -> Constr
forall nodeName.
Data nodeName =>
LimitedLinking nodeName -> DataType
forall nodeName.
Data nodeName =>
(forall b. Data b => b -> b)
-> LimitedLinking nodeName -> LimitedLinking nodeName
forall nodeName u.
Data nodeName =>
Int -> (forall d. Data d => d -> u) -> LimitedLinking nodeName -> u
forall nodeName u.
Data nodeName =>
(forall d. Data d => d -> u) -> LimitedLinking nodeName -> [u]
forall nodeName r r'.
Data nodeName =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
forall nodeName r r'.
Data nodeName =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
forall nodeName (m :: * -> *).
(Data nodeName, Monad m) =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
forall nodeName (m :: * -> *).
(Data nodeName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
forall nodeName (c :: * -> *).
Data nodeName =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LimitedLinking nodeName)
forall nodeName (c :: * -> *).
Data nodeName =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LimitedLinking nodeName
-> c (LimitedLinking nodeName)
forall nodeName (t :: * -> *) (c :: * -> *).
(Data nodeName, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (LimitedLinking nodeName))
forall nodeName (t :: * -> * -> *) (c :: * -> *).
(Data nodeName, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LimitedLinking nodeName))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LimitedLinking nodeName -> u
forall u.
(forall d. Data d => d -> u) -> LimitedLinking nodeName -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LimitedLinking nodeName)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LimitedLinking nodeName
-> c (LimitedLinking nodeName)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (LimitedLinking nodeName))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LimitedLinking nodeName))
$cgfoldl :: forall nodeName (c :: * -> *).
Data nodeName =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LimitedLinking nodeName
-> c (LimitedLinking nodeName)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LimitedLinking nodeName
-> c (LimitedLinking nodeName)
$cgunfold :: forall nodeName (c :: * -> *).
Data nodeName =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LimitedLinking nodeName)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LimitedLinking nodeName)
$ctoConstr :: forall nodeName. Data nodeName => LimitedLinking nodeName -> Constr
toConstr :: LimitedLinking nodeName -> Constr
$cdataTypeOf :: forall nodeName.
Data nodeName =>
LimitedLinking nodeName -> DataType
dataTypeOf :: LimitedLinking nodeName -> DataType
$cdataCast1 :: forall nodeName (t :: * -> *) (c :: * -> *).
(Data nodeName, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (LimitedLinking nodeName))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (LimitedLinking nodeName))
$cdataCast2 :: forall nodeName (t :: * -> * -> *) (c :: * -> *).
(Data nodeName, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LimitedLinking nodeName))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LimitedLinking nodeName))
$cgmapT :: forall nodeName.
Data nodeName =>
(forall b. Data b => b -> b)
-> LimitedLinking nodeName -> LimitedLinking nodeName
gmapT :: (forall b. Data b => b -> b)
-> LimitedLinking nodeName -> LimitedLinking nodeName
$cgmapQl :: forall nodeName r r'.
Data nodeName =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
$cgmapQr :: forall nodeName r r'.
Data nodeName =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> LimitedLinking nodeName
-> r
$cgmapQ :: forall nodeName u.
Data nodeName =>
(forall d. Data d => d -> u) -> LimitedLinking nodeName -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> LimitedLinking nodeName -> [u]
$cgmapQi :: forall nodeName u.
Data nodeName =>
Int -> (forall d. Data d => d -> u) -> LimitedLinking nodeName -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LimitedLinking nodeName -> u
$cgmapM :: forall nodeName (m :: * -> *).
(Data nodeName, Monad m) =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
$cgmapMp :: forall nodeName (m :: * -> *).
(Data nodeName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
$cgmapMo :: forall nodeName (m :: * -> *).
(Data nodeName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LimitedLinking nodeName -> m (LimitedLinking nodeName)
Data, LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
(LimitedLinking nodeName -> LimitedLinking nodeName -> Bool)
-> (LimitedLinking nodeName -> LimitedLinking nodeName -> Bool)
-> Eq (LimitedLinking nodeName)
forall nodeName.
Eq nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall nodeName.
Eq nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
== :: LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
$c/= :: forall nodeName.
Eq nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
/= :: LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
Eq, (forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b)
-> (forall a b. a -> LimitedLinking b -> LimitedLinking a)
-> Functor LimitedLinking
forall a b. a -> LimitedLinking b -> LimitedLinking a
forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
fmap :: forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
$c<$ :: forall a b. a -> LimitedLinking b -> LimitedLinking a
<$ :: forall a b. a -> LimitedLinking b -> LimitedLinking a
Functor, (forall m. Monoid m => LimitedLinking m -> m)
-> (forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m)
-> (forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m)
-> (forall a b. (a -> b -> b) -> b -> LimitedLinking a -> b)
-> (forall a b. (a -> b -> b) -> b -> LimitedLinking a -> b)
-> (forall b a. (b -> a -> b) -> b -> LimitedLinking a -> b)
-> (forall b a. (b -> a -> b) -> b -> LimitedLinking a -> b)
-> (forall a. (a -> a -> a) -> LimitedLinking a -> a)
-> (forall a. (a -> a -> a) -> LimitedLinking a -> a)
-> (forall a. LimitedLinking a -> [a])
-> (forall a. LimitedLinking a -> Bool)
-> (forall a. LimitedLinking a -> Int)
-> (forall a. Eq a => a -> LimitedLinking a -> Bool)
-> (forall a. Ord a => LimitedLinking a -> a)
-> (forall a. Ord a => LimitedLinking a -> a)
-> (forall a. Num a => LimitedLinking a -> a)
-> (forall a. Num a => LimitedLinking a -> a)
-> Foldable LimitedLinking
forall a. Eq a => a -> LimitedLinking a -> Bool
forall a. Num a => LimitedLinking a -> a
forall a. Ord a => LimitedLinking a -> a
forall m. Monoid m => LimitedLinking m -> m
forall a. LimitedLinking a -> Bool
forall a. LimitedLinking a -> Int
forall a. LimitedLinking a -> [a]
forall a. (a -> a -> a) -> LimitedLinking a -> a
forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
forall b a. (b -> a -> b) -> b -> LimitedLinking a -> b
forall a b. (a -> b -> b) -> b -> LimitedLinking a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => LimitedLinking m -> m
fold :: forall m. Monoid m => LimitedLinking m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> LimitedLinking a -> b
foldr :: forall a b. (a -> b -> b) -> b -> LimitedLinking a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> LimitedLinking a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> LimitedLinking a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> LimitedLinking a -> b
foldl :: forall b a. (b -> a -> b) -> b -> LimitedLinking a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> LimitedLinking a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> LimitedLinking a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> LimitedLinking a -> a
foldr1 :: forall a. (a -> a -> a) -> LimitedLinking a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> LimitedLinking a -> a
foldl1 :: forall a. (a -> a -> a) -> LimitedLinking a -> a
$ctoList :: forall a. LimitedLinking a -> [a]
toList :: forall a. LimitedLinking a -> [a]
$cnull :: forall a. LimitedLinking a -> Bool
null :: forall a. LimitedLinking a -> Bool
$clength :: forall a. LimitedLinking a -> Int
length :: forall a. LimitedLinking a -> Int
$celem :: forall a. Eq a => a -> LimitedLinking a -> Bool
elem :: forall a. Eq a => a -> LimitedLinking a -> Bool
$cmaximum :: forall a. Ord a => LimitedLinking a -> a
maximum :: forall a. Ord a => LimitedLinking a -> a
$cminimum :: forall a. Ord a => LimitedLinking a -> a
minimum :: forall a. Ord a => LimitedLinking a -> a
$csum :: forall a. Num a => LimitedLinking a -> a
sum :: forall a. Num a => LimitedLinking a -> a
$cproduct :: forall a. Num a => LimitedLinking a -> a
product :: forall a. Num a => LimitedLinking a -> a
Foldable, (forall x.
 LimitedLinking nodeName -> Rep (LimitedLinking nodeName) x)
-> (forall x.
    Rep (LimitedLinking nodeName) x -> LimitedLinking nodeName)
-> Generic (LimitedLinking nodeName)
forall x.
Rep (LimitedLinking nodeName) x -> LimitedLinking nodeName
forall x.
LimitedLinking nodeName -> Rep (LimitedLinking nodeName) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall nodeName x.
Rep (LimitedLinking nodeName) x -> LimitedLinking nodeName
forall nodeName x.
LimitedLinking nodeName -> Rep (LimitedLinking nodeName) x
$cfrom :: forall nodeName x.
LimitedLinking nodeName -> Rep (LimitedLinking nodeName) x
from :: forall x.
LimitedLinking nodeName -> Rep (LimitedLinking nodeName) x
$cto :: forall nodeName x.
Rep (LimitedLinking nodeName) x -> LimitedLinking nodeName
to :: forall x.
Rep (LimitedLinking nodeName) x -> LimitedLinking nodeName
Generic, Eq (LimitedLinking nodeName)
Eq (LimitedLinking nodeName)
-> (LimitedLinking nodeName -> LimitedLinking nodeName -> Ordering)
-> (LimitedLinking nodeName -> LimitedLinking nodeName -> Bool)
-> (LimitedLinking nodeName -> LimitedLinking nodeName -> Bool)
-> (LimitedLinking nodeName -> LimitedLinking nodeName -> Bool)
-> (LimitedLinking nodeName -> LimitedLinking nodeName -> Bool)
-> (LimitedLinking nodeName
    -> LimitedLinking nodeName -> LimitedLinking nodeName)
-> (LimitedLinking nodeName
    -> LimitedLinking nodeName -> LimitedLinking nodeName)
-> Ord (LimitedLinking nodeName)
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
LimitedLinking nodeName -> LimitedLinking nodeName -> Ordering
LimitedLinking nodeName
-> LimitedLinking nodeName -> LimitedLinking nodeName
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 {nodeName}. Ord nodeName => Eq (LimitedLinking nodeName)
forall nodeName.
Ord nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
forall nodeName.
Ord nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Ordering
forall nodeName.
Ord nodeName =>
LimitedLinking nodeName
-> LimitedLinking nodeName -> LimitedLinking nodeName
$ccompare :: forall nodeName.
Ord nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Ordering
compare :: LimitedLinking nodeName -> LimitedLinking nodeName -> Ordering
$c< :: forall nodeName.
Ord nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
< :: LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
$c<= :: forall nodeName.
Ord nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
<= :: LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
$c> :: forall nodeName.
Ord nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
> :: LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
$c>= :: forall nodeName.
Ord nodeName =>
LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
>= :: LimitedLinking nodeName -> LimitedLinking nodeName -> Bool
$cmax :: forall nodeName.
Ord nodeName =>
LimitedLinking nodeName
-> LimitedLinking nodeName -> LimitedLinking nodeName
max :: LimitedLinking nodeName
-> LimitedLinking nodeName -> LimitedLinking nodeName
$cmin :: forall nodeName.
Ord nodeName =>
LimitedLinking nodeName
-> LimitedLinking nodeName -> LimitedLinking nodeName
min :: LimitedLinking nodeName
-> LimitedLinking nodeName -> LimitedLinking nodeName
Ord, ReadPrec [LimitedLinking nodeName]
ReadPrec (LimitedLinking nodeName)
Int -> ReadS (LimitedLinking nodeName)
ReadS [LimitedLinking nodeName]
(Int -> ReadS (LimitedLinking nodeName))
-> ReadS [LimitedLinking nodeName]
-> ReadPrec (LimitedLinking nodeName)
-> ReadPrec [LimitedLinking nodeName]
-> Read (LimitedLinking nodeName)
forall nodeName.
Read nodeName =>
ReadPrec [LimitedLinking nodeName]
forall nodeName.
Read nodeName =>
ReadPrec (LimitedLinking nodeName)
forall nodeName.
Read nodeName =>
Int -> ReadS (LimitedLinking nodeName)
forall nodeName. Read nodeName => ReadS [LimitedLinking nodeName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall nodeName.
Read nodeName =>
Int -> ReadS (LimitedLinking nodeName)
readsPrec :: Int -> ReadS (LimitedLinking nodeName)
$creadList :: forall nodeName. Read nodeName => ReadS [LimitedLinking nodeName]
readList :: ReadS [LimitedLinking nodeName]
$creadPrec :: forall nodeName.
Read nodeName =>
ReadPrec (LimitedLinking nodeName)
readPrec :: ReadPrec (LimitedLinking nodeName)
$creadListPrec :: forall nodeName.
Read nodeName =>
ReadPrec [LimitedLinking nodeName]
readListPrec :: ReadPrec [LimitedLinking nodeName]
Read, Int -> LimitedLinking nodeName -> ShowS
[LimitedLinking nodeName] -> ShowS
LimitedLinking nodeName -> String
(Int -> LimitedLinking nodeName -> ShowS)
-> (LimitedLinking nodeName -> String)
-> ([LimitedLinking nodeName] -> ShowS)
-> Show (LimitedLinking nodeName)
forall nodeName.
Show nodeName =>
Int -> LimitedLinking nodeName -> ShowS
forall nodeName.
Show nodeName =>
[LimitedLinking nodeName] -> ShowS
forall nodeName. Show nodeName => LimitedLinking nodeName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall nodeName.
Show nodeName =>
Int -> LimitedLinking nodeName -> ShowS
showsPrec :: Int -> LimitedLinking nodeName -> ShowS
$cshow :: forall nodeName. Show nodeName => LimitedLinking nodeName -> String
show :: LimitedLinking nodeName -> String
$cshowList :: forall nodeName.
Show nodeName =>
[LimitedLinking nodeName] -> ShowS
showList :: [LimitedLinking nodeName] -> ShowS
Show, Functor LimitedLinking
Foldable LimitedLinking
Functor LimitedLinking
-> Foldable LimitedLinking
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LimitedLinking a -> f (LimitedLinking b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LimitedLinking (f a) -> f (LimitedLinking a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LimitedLinking a -> m (LimitedLinking b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LimitedLinking (m a) -> m (LimitedLinking a))
-> Traversable LimitedLinking
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
LimitedLinking (m a) -> m (LimitedLinking a)
forall (f :: * -> *) a.
Applicative f =>
LimitedLinking (f a) -> f (LimitedLinking a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LimitedLinking a -> m (LimitedLinking b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
LimitedLinking (f a) -> f (LimitedLinking a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
LimitedLinking (f a) -> f (LimitedLinking a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LimitedLinking a -> m (LimitedLinking b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LimitedLinking a -> m (LimitedLinking b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
LimitedLinking (m a) -> m (LimitedLinking a)
sequence :: forall (m :: * -> *) a.
Monad m =>
LimitedLinking (m a) -> m (LimitedLinking a)
Traversable)

{-|
A variation of 'LimitedLinking' that can fallback to a default limit
and includes the range expression.
-}
data DefaultedLimitedLinking = DefaultedLimitedLinking {
  -- | lower and upper bounds
  DefaultedLimitedLinking -> Maybe (Int, Maybe Int)
defaultedLimits :: Maybe (Int, Maybe Int),
  -- | a string representing the range
  DefaultedLimitedLinking -> Maybe String
defaultedRange :: Maybe String,
  -- | the target to which it is linking
  DefaultedLimitedLinking -> String
defaultedLinking :: !String
  }

{-|
Return lower limit first, higher second.
-}
sortLimits
  :: DefaultedLimitedLinking
  -> DefaultedLimitedLinking
  -> (DefaultedLimitedLinking, DefaultedLimitedLinking)
sortLimits :: DefaultedLimitedLinking
-> DefaultedLimitedLinking
-> (DefaultedLimitedLinking, DefaultedLimitedLinking)
sortLimits DefaultedLimitedLinking
limit1 DefaultedLimitedLinking
limit2 = (DefaultedLimitedLinking
lower, DefaultedLimitedLinking
higher)
  where
    (DefaultedLimitedLinking
lower, DefaultedLimitedLinking
higher)
      | DefaultedLimitedLinking -> Maybe (Int, Maybe Int)
defaultedLimits DefaultedLimitedLinking
limit1 Maybe (Int, Maybe Int) -> Maybe (Int, Maybe Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= DefaultedLimitedLinking -> Maybe (Int, Maybe Int)
defaultedLimits DefaultedLimitedLinking
limit2
      = (DefaultedLimitedLinking
limit1, DefaultedLimitedLinking
limit2)
      | Bool
otherwise
      = (DefaultedLimitedLinking
limit2, DefaultedLimitedLinking
limit1)

{-|
Smart constructor for creating 'DefaultedLimitedLinking'
based on a default and a 'LimitedLinking'.
-}
defaultedLimitedLinking
  :: Maybe (Int, Maybe Int)
  -> LimitedLinking String
  -> DefaultedLimitedLinking
defaultedLimitedLinking :: Maybe (Int, Maybe Int)
-> LimitedLinking String -> DefaultedLimitedLinking
defaultedLimitedLinking Maybe (Int, Maybe Int)
defaultLimits LimitedLinking {String
(Int, Maybe Int)
linking :: forall nodeName. LimitedLinking nodeName -> nodeName
limits :: forall nodeName. LimitedLinking nodeName -> (Int, Maybe Int)
linking :: String
limits :: (Int, Maybe Int)
..}
  = DefaultedLimitedLinking {
    defaultedLimits :: Maybe (Int, Maybe Int)
defaultedLimits = Maybe (Int, Maybe Int)
-> (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. Eq a => Maybe a -> a -> Maybe a
justNotDefault Maybe (Int, Maybe Int)
defaultLimits (Int, Maybe Int)
limits,
    defaultedRange :: Maybe String
defaultedRange = Maybe (Int, Maybe Int) -> (Int, Maybe Int) -> Maybe String
rangeWithDefault Maybe (Int, Maybe Int)
defaultLimits (Int, Maybe Int)
limits,
    defaultedLinking :: String
defaultedLinking = String
linking
    }

{-|
Nothing if default is hit, else 'Just' the value.
-}
justNotDefault :: Eq a => Maybe a -> a -> Maybe a
justNotDefault :: forall a. Eq a => Maybe a -> a -> Maybe a
justNotDefault Maybe a
defaultValue a
value
  | a -> Maybe a
forall a. a -> Maybe a
Just a
value Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe a
defaultValue
  = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise
  = a -> Maybe a
forall a. a -> Maybe a
Just a
value

{-|
A range expression as shown in class diagrams (or 'Nothing' if default is hit).
-}
rangeWithDefault
  :: Maybe (Int, Maybe Int)
  -- ^ the default
  -> (Int, Maybe Int)
  -- ^ range for which to return the range expression
  -> Maybe String
rangeWithDefault :: Maybe (Int, Maybe Int) -> (Int, Maybe Int) -> Maybe String
rangeWithDefault Maybe (Int, Maybe Int)
defaultValue = ((Int, Maybe Int) -> String)
-> Maybe (Int, Maybe Int) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Maybe Int) -> String
forall {a}. (Show a, Eq a, Num a) => (a, Maybe a) -> String
range (Maybe (Int, Maybe Int) -> Maybe String)
-> ((Int, Maybe Int) -> Maybe (Int, Maybe Int))
-> (Int, Maybe Int)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int, Maybe Int)
-> (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. Eq a => Maybe a -> a -> Maybe a
justNotDefault Maybe (Int, Maybe Int)
defaultValue
  where
    range :: (a, Maybe a) -> String
range (a
l, Maybe a
Nothing) = a -> String
forall a. Show a => a -> String
show a
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..*"
    range (a
l, Just a
u)
      | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1   = String
"*.." String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
u
      | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
u    = a -> String
forall a. Show a => a -> String
show a
l
      | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".." String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
u

{-|
All possible relationships within a `ClassDiagram`.
-}
data Relationship className relationshipName
  = Association {
    forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationName           :: relationshipName,
    forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationFrom           :: LimitedLinking className,
    forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo             :: LimitedLinking className
    }
  | Aggregation {
    forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationName           :: relationshipName,
    forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationPart           :: LimitedLinking className,
    forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole          :: LimitedLinking className
    }
  | Composition {
    forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionName           :: relationshipName,
    forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionPart           :: LimitedLinking className,
    forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole          :: LimitedLinking className
    }
  | Inheritance {
    forall className relationshipName.
Relationship className relationshipName -> className
subClass                  :: className,
    forall className relationshipName.
Relationship className relationshipName -> className
superClass                :: className
    }
  deriving (Typeable (Relationship className relationshipName)
Typeable (Relationship className relationshipName)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> Relationship className relationshipName
    -> c (Relationship className relationshipName))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c (Relationship className relationshipName))
-> (Relationship className relationshipName -> Constr)
-> (Relationship className relationshipName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (Relationship className relationshipName)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Relationship className relationshipName)))
-> ((forall b. Data b => b -> b)
    -> Relationship className relationshipName
    -> Relationship className relationshipName)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> Relationship className relationshipName
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> Relationship className relationshipName
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> Relationship className relationshipName -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> Relationship className relationshipName
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Relationship className relationshipName
    -> m (Relationship className relationshipName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Relationship className relationshipName
    -> m (Relationship className relationshipName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Relationship className relationshipName
    -> m (Relationship className relationshipName))
-> Data (Relationship className relationshipName)
Relationship className relationshipName -> Constr
Relationship className relationshipName -> DataType
(forall b. Data b => b -> b)
-> Relationship className relationshipName
-> Relationship className relationshipName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> Relationship className relationshipName
-> u
forall u.
(forall d. Data d => d -> u)
-> Relationship className relationshipName -> [u]
forall {className} {relationshipName}.
(Data relationshipName, Data className) =>
Typeable (Relationship className relationshipName)
forall className relationshipName.
(Data relationshipName, Data className) =>
Relationship className relationshipName -> Constr
forall className relationshipName.
(Data relationshipName, Data className) =>
Relationship className relationshipName -> DataType
forall className relationshipName.
(Data relationshipName, Data className) =>
(forall b. Data b => b -> b)
-> Relationship className relationshipName
-> Relationship className relationshipName
forall className relationshipName u.
(Data relationshipName, Data className) =>
Int
-> (forall d. Data d => d -> u)
-> Relationship className relationshipName
-> u
forall className relationshipName u.
(Data relationshipName, Data className) =>
(forall d. Data d => d -> u)
-> Relationship className relationshipName -> [u]
forall className relationshipName r r'.
(Data relationshipName, Data className) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
forall className relationshipName r r'.
(Data relationshipName, Data className) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
forall className relationshipName (m :: * -> *).
(Data relationshipName, Data className, Monad m) =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
forall className relationshipName (m :: * -> *).
(Data relationshipName, Data className, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
forall className relationshipName (c :: * -> *).
(Data relationshipName, Data className) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Relationship className relationshipName)
forall className relationshipName (c :: * -> *).
(Data relationshipName, Data className) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Relationship className relationshipName
-> c (Relationship className relationshipName)
forall className relationshipName (t :: * -> *) (c :: * -> *).
(Data relationshipName, Data className, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (Relationship className relationshipName))
forall className relationshipName (t :: * -> * -> *) (c :: * -> *).
(Data relationshipName, Data className, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Relationship className relationshipName))
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Relationship className relationshipName)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Relationship className relationshipName
-> c (Relationship className relationshipName)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (Relationship className relationshipName))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Relationship className relationshipName))
$cgfoldl :: forall className relationshipName (c :: * -> *).
(Data relationshipName, Data className) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Relationship className relationshipName
-> c (Relationship className relationshipName)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Relationship className relationshipName
-> c (Relationship className relationshipName)
$cgunfold :: forall className relationshipName (c :: * -> *).
(Data relationshipName, Data className) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Relationship className relationshipName)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Relationship className relationshipName)
$ctoConstr :: forall className relationshipName.
(Data relationshipName, Data className) =>
Relationship className relationshipName -> Constr
toConstr :: Relationship className relationshipName -> Constr
$cdataTypeOf :: forall className relationshipName.
(Data relationshipName, Data className) =>
Relationship className relationshipName -> DataType
dataTypeOf :: Relationship className relationshipName -> DataType
$cdataCast1 :: forall className relationshipName (t :: * -> *) (c :: * -> *).
(Data relationshipName, Data className, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (Relationship className relationshipName))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (Relationship className relationshipName))
$cdataCast2 :: forall className relationshipName (t :: * -> * -> *) (c :: * -> *).
(Data relationshipName, Data className, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Relationship className relationshipName))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Relationship className relationshipName))
$cgmapT :: forall className relationshipName.
(Data relationshipName, Data className) =>
(forall b. Data b => b -> b)
-> Relationship className relationshipName
-> Relationship className relationshipName
gmapT :: (forall b. Data b => b -> b)
-> Relationship className relationshipName
-> Relationship className relationshipName
$cgmapQl :: forall className relationshipName r r'.
(Data relationshipName, Data className) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
$cgmapQr :: forall className relationshipName r r'.
(Data relationshipName, Data className) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Relationship className relationshipName
-> r
$cgmapQ :: forall className relationshipName u.
(Data relationshipName, Data className) =>
(forall d. Data d => d -> u)
-> Relationship className relationshipName -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> Relationship className relationshipName -> [u]
$cgmapQi :: forall className relationshipName u.
(Data relationshipName, Data className) =>
Int
-> (forall d. Data d => d -> u)
-> Relationship className relationshipName
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> Relationship className relationshipName
-> u
$cgmapM :: forall className relationshipName (m :: * -> *).
(Data relationshipName, Data className, Monad m) =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
$cgmapMp :: forall className relationshipName (m :: * -> *).
(Data relationshipName, Data className, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
$cgmapMo :: forall className relationshipName (m :: * -> *).
(Data relationshipName, Data className, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Relationship className relationshipName
-> m (Relationship className relationshipName)
Data, Relationship className relationshipName
-> Relationship className relationshipName -> Bool
(Relationship className relationshipName
 -> Relationship className relationshipName -> Bool)
-> (Relationship className relationshipName
    -> Relationship className relationshipName -> Bool)
-> Eq (Relationship className relationshipName)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall className relationshipName.
(Eq relationshipName, Eq className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
$c== :: forall className relationshipName.
(Eq relationshipName, Eq className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
== :: Relationship className relationshipName
-> Relationship className relationshipName -> Bool
$c/= :: forall className relationshipName.
(Eq relationshipName, Eq className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
/= :: Relationship className relationshipName
-> Relationship className relationshipName -> Bool
Eq, (forall a b.
 (a -> b) -> Relationship className a -> Relationship className b)
-> (forall a b.
    a -> Relationship className b -> Relationship className a)
-> Functor (Relationship className)
forall a b.
a -> Relationship className b -> Relationship className a
forall a b.
(a -> b) -> Relationship className a -> Relationship className b
forall className a b.
a -> Relationship className b -> Relationship className a
forall className a b.
(a -> b) -> Relationship className a -> Relationship className b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall className a b.
(a -> b) -> Relationship className a -> Relationship className b
fmap :: forall a b.
(a -> b) -> Relationship className a -> Relationship className b
$c<$ :: forall className a b.
a -> Relationship className b -> Relationship className a
<$ :: forall a b.
a -> Relationship className b -> Relationship className a
Functor, (forall x.
 Relationship className relationshipName
 -> Rep (Relationship className relationshipName) x)
-> (forall x.
    Rep (Relationship className relationshipName) x
    -> Relationship className relationshipName)
-> Generic (Relationship className relationshipName)
forall x.
Rep (Relationship className relationshipName) x
-> Relationship className relationshipName
forall x.
Relationship className relationshipName
-> Rep (Relationship className relationshipName) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall className relationshipName x.
Rep (Relationship className relationshipName) x
-> Relationship className relationshipName
forall className relationshipName x.
Relationship className relationshipName
-> Rep (Relationship className relationshipName) x
$cfrom :: forall className relationshipName x.
Relationship className relationshipName
-> Rep (Relationship className relationshipName) x
from :: forall x.
Relationship className relationshipName
-> Rep (Relationship className relationshipName) x
$cto :: forall className relationshipName x.
Rep (Relationship className relationshipName) x
-> Relationship className relationshipName
to :: forall x.
Rep (Relationship className relationshipName) x
-> Relationship className relationshipName
Generic, Eq (Relationship className relationshipName)
Eq (Relationship className relationshipName)
-> (Relationship className relationshipName
    -> Relationship className relationshipName -> Ordering)
-> (Relationship className relationshipName
    -> Relationship className relationshipName -> Bool)
-> (Relationship className relationshipName
    -> Relationship className relationshipName -> Bool)
-> (Relationship className relationshipName
    -> Relationship className relationshipName -> Bool)
-> (Relationship className relationshipName
    -> Relationship className relationshipName -> Bool)
-> (Relationship className relationshipName
    -> Relationship className relationshipName
    -> Relationship className relationshipName)
-> (Relationship className relationshipName
    -> Relationship className relationshipName
    -> Relationship className relationshipName)
-> Ord (Relationship className relationshipName)
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
Relationship className relationshipName
-> Relationship className relationshipName -> Ordering
Relationship className relationshipName
-> Relationship className relationshipName
-> Relationship className relationshipName
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 {className} {relationshipName}.
(Ord relationshipName, Ord className) =>
Eq (Relationship className relationshipName)
forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Ordering
forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName
-> Relationship className relationshipName
$ccompare :: forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Ordering
compare :: Relationship className relationshipName
-> Relationship className relationshipName -> Ordering
$c< :: forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
< :: Relationship className relationshipName
-> Relationship className relationshipName -> Bool
$c<= :: forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
<= :: Relationship className relationshipName
-> Relationship className relationshipName -> Bool
$c> :: forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
> :: Relationship className relationshipName
-> Relationship className relationshipName -> Bool
$c>= :: forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName -> Bool
>= :: Relationship className relationshipName
-> Relationship className relationshipName -> Bool
$cmax :: forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName
-> Relationship className relationshipName
max :: Relationship className relationshipName
-> Relationship className relationshipName
-> Relationship className relationshipName
$cmin :: forall className relationshipName.
(Ord relationshipName, Ord className) =>
Relationship className relationshipName
-> Relationship className relationshipName
-> Relationship className relationshipName
min :: Relationship className relationshipName
-> Relationship className relationshipName
-> Relationship className relationshipName
Ord, ReadPrec [Relationship className relationshipName]
ReadPrec (Relationship className relationshipName)
Int -> ReadS (Relationship className relationshipName)
ReadS [Relationship className relationshipName]
(Int -> ReadS (Relationship className relationshipName))
-> ReadS [Relationship className relationshipName]
-> ReadPrec (Relationship className relationshipName)
-> ReadPrec [Relationship className relationshipName]
-> Read (Relationship className relationshipName)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall className relationshipName.
(Read relationshipName, Read className) =>
ReadPrec [Relationship className relationshipName]
forall className relationshipName.
(Read relationshipName, Read className) =>
ReadPrec (Relationship className relationshipName)
forall className relationshipName.
(Read relationshipName, Read className) =>
Int -> ReadS (Relationship className relationshipName)
forall className relationshipName.
(Read relationshipName, Read className) =>
ReadS [Relationship className relationshipName]
$creadsPrec :: forall className relationshipName.
(Read relationshipName, Read className) =>
Int -> ReadS (Relationship className relationshipName)
readsPrec :: Int -> ReadS (Relationship className relationshipName)
$creadList :: forall className relationshipName.
(Read relationshipName, Read className) =>
ReadS [Relationship className relationshipName]
readList :: ReadS [Relationship className relationshipName]
$creadPrec :: forall className relationshipName.
(Read relationshipName, Read className) =>
ReadPrec (Relationship className relationshipName)
readPrec :: ReadPrec (Relationship className relationshipName)
$creadListPrec :: forall className relationshipName.
(Read relationshipName, Read className) =>
ReadPrec [Relationship className relationshipName]
readListPrec :: ReadPrec [Relationship className relationshipName]
Read, Int -> Relationship className relationshipName -> ShowS
[Relationship className relationshipName] -> ShowS
Relationship className relationshipName -> String
(Int -> Relationship className relationshipName -> ShowS)
-> (Relationship className relationshipName -> String)
-> ([Relationship className relationshipName] -> ShowS)
-> Show (Relationship className relationshipName)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall className relationshipName.
(Show relationshipName, Show className) =>
Int -> Relationship className relationshipName -> ShowS
forall className relationshipName.
(Show relationshipName, Show className) =>
[Relationship className relationshipName] -> ShowS
forall className relationshipName.
(Show relationshipName, Show className) =>
Relationship className relationshipName -> String
$cshowsPrec :: forall className relationshipName.
(Show relationshipName, Show className) =>
Int -> Relationship className relationshipName -> ShowS
showsPrec :: Int -> Relationship className relationshipName -> ShowS
$cshow :: forall className relationshipName.
(Show relationshipName, Show className) =>
Relationship className relationshipName -> String
show :: Relationship className relationshipName -> String
$cshowList :: forall className relationshipName.
(Show relationshipName, Show className) =>
[Relationship className relationshipName] -> ShowS
showList :: [Relationship className relationshipName] -> ShowS
Show)

instance Bifunctor Relationship where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Relationship a c -> Relationship b d
bimap a -> b
f c -> d
g Relationship a c
r = case Relationship a c
r of
    Association {c
LimitedLinking a
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: c
associationFrom :: LimitedLinking a
associationTo :: LimitedLinking a
..} -> Association {
      associationName :: d
associationName         = c -> d
g c
associationName,
      associationFrom :: LimitedLinking b
associationFrom         = (a -> b) -> LimitedLinking a -> LimitedLinking b
forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LimitedLinking a
associationFrom,
      associationTo :: LimitedLinking b
associationTo           = (a -> b) -> LimitedLinking a -> LimitedLinking b
forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LimitedLinking a
associationTo
      }
    Aggregation {c
LimitedLinking a
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: c
aggregationPart :: LimitedLinking a
aggregationWhole :: LimitedLinking a
..} -> Aggregation {
      aggregationName :: d
aggregationName         = c -> d
g c
aggregationName,
      aggregationPart :: LimitedLinking b
aggregationPart         = (a -> b) -> LimitedLinking a -> LimitedLinking b
forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LimitedLinking a
aggregationPart,
      aggregationWhole :: LimitedLinking b
aggregationWhole        = (a -> b) -> LimitedLinking a -> LimitedLinking b
forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LimitedLinking a
aggregationWhole
      }
    Composition {c
LimitedLinking a
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: c
compositionPart :: LimitedLinking a
compositionWhole :: LimitedLinking a
..} -> Composition {
      compositionName :: d
compositionName         = c -> d
g c
compositionName,
      compositionPart :: LimitedLinking b
compositionPart         = (a -> b) -> LimitedLinking a -> LimitedLinking b
forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LimitedLinking a
compositionPart,
      compositionWhole :: LimitedLinking b
compositionWhole        = (a -> b) -> LimitedLinking a -> LimitedLinking b
forall a b. (a -> b) -> LimitedLinking a -> LimitedLinking b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LimitedLinking a
compositionWhole
      }
    Inheritance {a
subClass :: forall className relationshipName.
Relationship className relationshipName -> className
superClass :: forall className relationshipName.
Relationship className relationshipName -> className
subClass :: a
superClass :: a
..} -> Inheritance {
      subClass :: b
subClass                = a -> b
f a
subClass,
      superClass :: b
superClass              = a -> b
f a
superClass
      }

instance Bifoldable Relationship where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Relationship a b -> m
bifoldMap a -> m
f b -> m
g Relationship a b
r = case Relationship a b
r of
    Association {b
LimitedLinking a
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: b
associationFrom :: LimitedLinking a
associationTo :: LimitedLinking a
..} -> b -> m
g b
associationName
      m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> LimitedLinking a -> m
forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f LimitedLinking a
associationFrom
      m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> LimitedLinking a -> m
forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f LimitedLinking a
associationTo
    Aggregation {b
LimitedLinking a
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: b
aggregationPart :: LimitedLinking a
aggregationWhole :: LimitedLinking a
..} -> b -> m
g b
aggregationName
      m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> LimitedLinking a -> m
forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f LimitedLinking a
aggregationPart
      m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> LimitedLinking a -> m
forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f LimitedLinking a
aggregationWhole
    Composition {b
LimitedLinking a
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: b
compositionPart :: LimitedLinking a
compositionWhole :: LimitedLinking a
..} -> b -> m
g b
compositionName
      m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> LimitedLinking a -> m
forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f LimitedLinking a
compositionPart
      m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> LimitedLinking a -> m
forall m a. Monoid m => (a -> m) -> LimitedLinking a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f LimitedLinking a
compositionWhole
    Inheritance {a
subClass :: forall className relationshipName.
Relationship className relationshipName -> className
superClass :: forall className relationshipName.
Relationship className relationshipName -> className
subClass :: a
superClass :: a
..} -> a -> m
f a
subClass
      m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
superClass

instance Bitraversable Relationship where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> Relationship a b -> f (Relationship c d)
bitraverse a -> f c
f b -> f d
g Relationship a b
r = case Relationship a b
r of
    Association {b
LimitedLinking a
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: b
associationFrom :: LimitedLinking a
associationTo :: LimitedLinking a
..} -> d -> LimitedLinking c -> LimitedLinking c -> Relationship c d
forall className relationshipName.
relationshipName
-> LimitedLinking className
-> LimitedLinking className
-> Relationship className relationshipName
Association
      (d -> LimitedLinking c -> LimitedLinking c -> Relationship c d)
-> f d
-> f (LimitedLinking c -> LimitedLinking c -> Relationship c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
associationName
      f (LimitedLinking c -> LimitedLinking c -> Relationship c d)
-> f (LimitedLinking c) -> f (LimitedLinking c -> Relationship c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> LimitedLinking a -> f (LimitedLinking c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
traverse a -> f c
f LimitedLinking a
associationFrom
      f (LimitedLinking c -> Relationship c d)
-> f (LimitedLinking c) -> f (Relationship c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> LimitedLinking a -> f (LimitedLinking c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
traverse a -> f c
f LimitedLinking a
associationTo
    Aggregation {b
LimitedLinking a
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: b
aggregationPart :: LimitedLinking a
aggregationWhole :: LimitedLinking a
..} -> d -> LimitedLinking c -> LimitedLinking c -> Relationship c d
forall className relationshipName.
relationshipName
-> LimitedLinking className
-> LimitedLinking className
-> Relationship className relationshipName
Aggregation
      (d -> LimitedLinking c -> LimitedLinking c -> Relationship c d)
-> f d
-> f (LimitedLinking c -> LimitedLinking c -> Relationship c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
aggregationName
      f (LimitedLinking c -> LimitedLinking c -> Relationship c d)
-> f (LimitedLinking c) -> f (LimitedLinking c -> Relationship c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> LimitedLinking a -> f (LimitedLinking c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
traverse a -> f c
f LimitedLinking a
aggregationPart
      f (LimitedLinking c -> Relationship c d)
-> f (LimitedLinking c) -> f (Relationship c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> LimitedLinking a -> f (LimitedLinking c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
traverse a -> f c
f LimitedLinking a
aggregationWhole
    Composition {b
LimitedLinking a
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: b
compositionPart :: LimitedLinking a
compositionWhole :: LimitedLinking a
..} -> d -> LimitedLinking c -> LimitedLinking c -> Relationship c d
forall className relationshipName.
relationshipName
-> LimitedLinking className
-> LimitedLinking className
-> Relationship className relationshipName
Composition
      (d -> LimitedLinking c -> LimitedLinking c -> Relationship c d)
-> f d
-> f (LimitedLinking c -> LimitedLinking c -> Relationship c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
compositionName
      f (LimitedLinking c -> LimitedLinking c -> Relationship c d)
-> f (LimitedLinking c) -> f (LimitedLinking c -> Relationship c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> LimitedLinking a -> f (LimitedLinking c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
traverse a -> f c
f LimitedLinking a
compositionPart
      f (LimitedLinking c -> Relationship c d)
-> f (LimitedLinking c) -> f (Relationship c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> LimitedLinking a -> f (LimitedLinking c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LimitedLinking a -> f (LimitedLinking b)
traverse a -> f c
f LimitedLinking a
compositionWhole
    Inheritance {a
subClass :: forall className relationshipName.
Relationship className relationshipName -> className
superClass :: forall className relationshipName.
Relationship className relationshipName -> className
subClass :: a
superClass :: a
..} -> c -> c -> Relationship c d
forall className relationshipName.
className -> className -> Relationship className relationshipName
Inheritance
      (c -> c -> Relationship c d) -> f c -> f (c -> Relationship c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
subClass
      f (c -> Relationship c d) -> f c -> f (Relationship c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f c
f a
superClass

data InvalidRelationship className relationshipName
  = InvalidInheritance {
    forall className relationshipName.
InvalidRelationship className relationshipName
-> LimitedLinking className
invalidSubClass :: !(LimitedLinking className),
    forall className relationshipName.
InvalidRelationship className relationshipName
-> LimitedLinking className
invalidSuperClass :: !(LimitedLinking className)
    }
  deriving (Typeable (InvalidRelationship className relationshipName)
Typeable (InvalidRelationship className relationshipName)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InvalidRelationship className relationshipName
    -> c (InvalidRelationship className relationshipName))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c (InvalidRelationship className relationshipName))
-> (InvalidRelationship className relationshipName -> Constr)
-> (InvalidRelationship className relationshipName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (InvalidRelationship className relationshipName)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (InvalidRelationship className relationshipName)))
-> ((forall b. Data b => b -> b)
    -> InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> InvalidRelationship className relationshipName
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> InvalidRelationship className relationshipName
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> InvalidRelationship className relationshipName -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> InvalidRelationship className relationshipName
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InvalidRelationship className relationshipName
    -> m (InvalidRelationship className relationshipName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InvalidRelationship className relationshipName
    -> m (InvalidRelationship className relationshipName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InvalidRelationship className relationshipName
    -> m (InvalidRelationship className relationshipName))
-> Data (InvalidRelationship className relationshipName)
InvalidRelationship className relationshipName -> Constr
InvalidRelationship className relationshipName -> DataType
(forall b. Data b => b -> b)
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName
-> u
forall u.
(forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName -> [u]
forall {className} {relationshipName}.
(Data className, Data relationshipName) =>
Typeable (InvalidRelationship className relationshipName)
forall className relationshipName.
(Data className, Data relationshipName) =>
InvalidRelationship className relationshipName -> Constr
forall className relationshipName.
(Data className, Data relationshipName) =>
InvalidRelationship className relationshipName -> DataType
forall className relationshipName.
(Data className, Data relationshipName) =>
(forall b. Data b => b -> b)
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
forall className relationshipName u.
(Data className, Data relationshipName) =>
Int
-> (forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName
-> u
forall className relationshipName u.
(Data className, Data relationshipName) =>
(forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName -> [u]
forall className relationshipName r r'.
(Data className, Data relationshipName) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
forall className relationshipName r r'.
(Data className, Data relationshipName) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
forall className relationshipName (m :: * -> *).
(Data className, Data relationshipName, Monad m) =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
forall className relationshipName (m :: * -> *).
(Data className, Data relationshipName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
forall className relationshipName (c :: * -> *).
(Data className, Data relationshipName) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (InvalidRelationship className relationshipName)
forall className relationshipName (c :: * -> *).
(Data className, Data relationshipName) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidRelationship className relationshipName
-> c (InvalidRelationship className relationshipName)
forall className relationshipName (t :: * -> *) (c :: * -> *).
(Data className, Data relationshipName, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (InvalidRelationship className relationshipName))
forall className relationshipName (t :: * -> * -> *) (c :: * -> *).
(Data className, Data relationshipName, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InvalidRelationship className relationshipName))
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (InvalidRelationship className relationshipName)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidRelationship className relationshipName
-> c (InvalidRelationship className relationshipName)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (InvalidRelationship className relationshipName))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InvalidRelationship className relationshipName))
$cgfoldl :: forall className relationshipName (c :: * -> *).
(Data className, Data relationshipName) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidRelationship className relationshipName
-> c (InvalidRelationship className relationshipName)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidRelationship className relationshipName
-> c (InvalidRelationship className relationshipName)
$cgunfold :: forall className relationshipName (c :: * -> *).
(Data className, Data relationshipName) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (InvalidRelationship className relationshipName)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (InvalidRelationship className relationshipName)
$ctoConstr :: forall className relationshipName.
(Data className, Data relationshipName) =>
InvalidRelationship className relationshipName -> Constr
toConstr :: InvalidRelationship className relationshipName -> Constr
$cdataTypeOf :: forall className relationshipName.
(Data className, Data relationshipName) =>
InvalidRelationship className relationshipName -> DataType
dataTypeOf :: InvalidRelationship className relationshipName -> DataType
$cdataCast1 :: forall className relationshipName (t :: * -> *) (c :: * -> *).
(Data className, Data relationshipName, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (InvalidRelationship className relationshipName))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (InvalidRelationship className relationshipName))
$cdataCast2 :: forall className relationshipName (t :: * -> * -> *) (c :: * -> *).
(Data className, Data relationshipName, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InvalidRelationship className relationshipName))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InvalidRelationship className relationshipName))
$cgmapT :: forall className relationshipName.
(Data className, Data relationshipName) =>
(forall b. Data b => b -> b)
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
gmapT :: (forall b. Data b => b -> b)
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
$cgmapQl :: forall className relationshipName r r'.
(Data className, Data relationshipName) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
$cgmapQr :: forall className relationshipName r r'.
(Data className, Data relationshipName) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InvalidRelationship className relationshipName
-> r
$cgmapQ :: forall className relationshipName u.
(Data className, Data relationshipName) =>
(forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName -> [u]
$cgmapQi :: forall className relationshipName u.
(Data className, Data relationshipName) =>
Int
-> (forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> InvalidRelationship className relationshipName
-> u
$cgmapM :: forall className relationshipName (m :: * -> *).
(Data className, Data relationshipName, Monad m) =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
$cgmapMp :: forall className relationshipName (m :: * -> *).
(Data className, Data relationshipName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
$cgmapMo :: forall className relationshipName (m :: * -> *).
(Data className, Data relationshipName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvalidRelationship className relationshipName
-> m (InvalidRelationship className relationshipName)
Data, InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
(InvalidRelationship className relationshipName
 -> InvalidRelationship className relationshipName -> Bool)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName -> Bool)
-> Eq (InvalidRelationship className relationshipName)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall className relationshipName.
Eq className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
$c== :: forall className relationshipName.
Eq className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
== :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
$c/= :: forall className relationshipName.
Eq className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
/= :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
Eq, (forall a b.
 (a -> b)
 -> InvalidRelationship className a
 -> InvalidRelationship className b)
-> (forall a b.
    a
    -> InvalidRelationship className b
    -> InvalidRelationship className a)
-> Functor (InvalidRelationship className)
forall a b.
a
-> InvalidRelationship className b
-> InvalidRelationship className a
forall a b.
(a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
forall className a b.
a
-> InvalidRelationship className b
-> InvalidRelationship className a
forall className a b.
(a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall className a b.
(a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
fmap :: forall a b.
(a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
$c<$ :: forall className a b.
a
-> InvalidRelationship className b
-> InvalidRelationship className a
<$ :: forall a b.
a
-> InvalidRelationship className b
-> InvalidRelationship className a
Functor, (forall x.
 InvalidRelationship className relationshipName
 -> Rep (InvalidRelationship className relationshipName) x)
-> (forall x.
    Rep (InvalidRelationship className relationshipName) x
    -> InvalidRelationship className relationshipName)
-> Generic (InvalidRelationship className relationshipName)
forall x.
Rep (InvalidRelationship className relationshipName) x
-> InvalidRelationship className relationshipName
forall x.
InvalidRelationship className relationshipName
-> Rep (InvalidRelationship className relationshipName) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall className relationshipName x.
Rep (InvalidRelationship className relationshipName) x
-> InvalidRelationship className relationshipName
forall className relationshipName x.
InvalidRelationship className relationshipName
-> Rep (InvalidRelationship className relationshipName) x
$cfrom :: forall className relationshipName x.
InvalidRelationship className relationshipName
-> Rep (InvalidRelationship className relationshipName) x
from :: forall x.
InvalidRelationship className relationshipName
-> Rep (InvalidRelationship className relationshipName) x
$cto :: forall className relationshipName x.
Rep (InvalidRelationship className relationshipName) x
-> InvalidRelationship className relationshipName
to :: forall x.
Rep (InvalidRelationship className relationshipName) x
-> InvalidRelationship className relationshipName
Generic, Eq (InvalidRelationship className relationshipName)
Eq (InvalidRelationship className relationshipName)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName -> Ordering)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName -> Bool)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName -> Bool)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName -> Bool)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName -> Bool)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName)
-> (InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName
    -> InvalidRelationship className relationshipName)
-> Ord (InvalidRelationship className relationshipName)
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Ordering
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
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 {className} {relationshipName}.
Ord className =>
Eq (InvalidRelationship className relationshipName)
forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Ordering
forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
$ccompare :: forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Ordering
compare :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Ordering
$c< :: forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
< :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
$c<= :: forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
<= :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
$c> :: forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
> :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
$c>= :: forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
>= :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName -> Bool
$cmax :: forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
max :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
$cmin :: forall className relationshipName.
Ord className =>
InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
min :: InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
-> InvalidRelationship className relationshipName
Ord, ReadPrec [InvalidRelationship className relationshipName]
ReadPrec (InvalidRelationship className relationshipName)
Int -> ReadS (InvalidRelationship className relationshipName)
ReadS [InvalidRelationship className relationshipName]
(Int -> ReadS (InvalidRelationship className relationshipName))
-> ReadS [InvalidRelationship className relationshipName]
-> ReadPrec (InvalidRelationship className relationshipName)
-> ReadPrec [InvalidRelationship className relationshipName]
-> Read (InvalidRelationship className relationshipName)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall className relationshipName.
Read className =>
ReadPrec [InvalidRelationship className relationshipName]
forall className relationshipName.
Read className =>
ReadPrec (InvalidRelationship className relationshipName)
forall className relationshipName.
Read className =>
Int -> ReadS (InvalidRelationship className relationshipName)
forall className relationshipName.
Read className =>
ReadS [InvalidRelationship className relationshipName]
$creadsPrec :: forall className relationshipName.
Read className =>
Int -> ReadS (InvalidRelationship className relationshipName)
readsPrec :: Int -> ReadS (InvalidRelationship className relationshipName)
$creadList :: forall className relationshipName.
Read className =>
ReadS [InvalidRelationship className relationshipName]
readList :: ReadS [InvalidRelationship className relationshipName]
$creadPrec :: forall className relationshipName.
Read className =>
ReadPrec (InvalidRelationship className relationshipName)
readPrec :: ReadPrec (InvalidRelationship className relationshipName)
$creadListPrec :: forall className relationshipName.
Read className =>
ReadPrec [InvalidRelationship className relationshipName]
readListPrec :: ReadPrec [InvalidRelationship className relationshipName]
Read, Int -> InvalidRelationship className relationshipName -> ShowS
[InvalidRelationship className relationshipName] -> ShowS
InvalidRelationship className relationshipName -> String
(Int -> InvalidRelationship className relationshipName -> ShowS)
-> (InvalidRelationship className relationshipName -> String)
-> ([InvalidRelationship className relationshipName] -> ShowS)
-> Show (InvalidRelationship className relationshipName)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall className relationshipName.
Show className =>
Int -> InvalidRelationship className relationshipName -> ShowS
forall className relationshipName.
Show className =>
[InvalidRelationship className relationshipName] -> ShowS
forall className relationshipName.
Show className =>
InvalidRelationship className relationshipName -> String
$cshowsPrec :: forall className relationshipName.
Show className =>
Int -> InvalidRelationship className relationshipName -> ShowS
showsPrec :: Int -> InvalidRelationship className relationshipName -> ShowS
$cshow :: forall className relationshipName.
Show className =>
InvalidRelationship className relationshipName -> String
show :: InvalidRelationship className relationshipName -> String
$cshowList :: forall className relationshipName.
Show className =>
[InvalidRelationship className relationshipName] -> ShowS
showList :: [InvalidRelationship className relationshipName] -> ShowS
Show)

$(deriveBifunctor ''InvalidRelationship)
$(deriveBifoldable ''InvalidRelationship)
$(deriveBitraversable ''InvalidRelationship)

type AnyRelationship className relationshipName
  = Either
    (InvalidRelationship className relationshipName)
    (Relationship className relationshipName)

relationshipName :: Relationship c r -> Maybe r
relationshipName :: forall c r. Relationship c r -> Maybe r
relationshipName Relationship c r
x = case Relationship c r
x of
  Association {r
LimitedLinking c
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: r
associationFrom :: LimitedLinking c
associationTo :: LimitedLinking c
..} -> r -> Maybe r
forall a. a -> Maybe a
Just r
associationName
  Aggregation {r
LimitedLinking c
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: r
aggregationPart :: LimitedLinking c
aggregationWhole :: LimitedLinking c
..} -> r -> Maybe r
forall a. a -> Maybe a
Just r
aggregationName
  Composition {r
LimitedLinking c
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: r
compositionPart :: LimitedLinking c
compositionWhole :: LimitedLinking c
..} -> r -> Maybe r
forall a. a -> Maybe a
Just r
compositionName
  Inheritance {}   -> Maybe r
forall a. Maybe a
Nothing

invalidRelationshipName
  :: InvalidRelationship className relationshipName
  -> Maybe relationshipName
invalidRelationshipName :: forall className relationshipName.
InvalidRelationship className relationshipName
-> Maybe relationshipName
invalidRelationshipName = \case
  InvalidInheritance {} -> Maybe relationshipName
forall a. Maybe a
Nothing

anyRelationshipName
  :: AnyRelationship className relationshipName
  -> Maybe relationshipName
anyRelationshipName :: forall className relationshipName.
AnyRelationship className relationshipName
-> Maybe relationshipName
anyRelationshipName = (InvalidRelationship className relationshipName
 -> Maybe relationshipName)
-> (Relationship className relationshipName
    -> Maybe relationshipName)
-> Either
     (InvalidRelationship className relationshipName)
     (Relationship className relationshipName)
-> Maybe relationshipName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either InvalidRelationship className relationshipName
-> Maybe relationshipName
forall className relationshipName.
InvalidRelationship className relationshipName
-> Maybe relationshipName
invalidRelationshipName Relationship className relationshipName -> Maybe relationshipName
forall c r. Relationship c r -> Maybe r
relationshipName

isRelationshipValid
  :: Eq className
  => Relationship className relationshipName
  -> Bool
isRelationshipValid :: forall className relationshipName.
Eq className =>
Relationship className relationshipName -> Bool
isRelationshipValid = \case
  Association {relationshipName
LimitedLinking className
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: relationshipName
associationFrom :: LimitedLinking className
associationTo :: LimitedLinking className
..} ->
    LimitedLinking className -> Bool
forall a. LimitedLinking a -> Bool
validLimit LimitedLinking className
associationFrom Bool -> Bool -> Bool
&& LimitedLinking className -> Bool
forall a. LimitedLinking a -> Bool
validLimit LimitedLinking className
associationTo
  Aggregation {relationshipName
LimitedLinking className
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: relationshipName
aggregationPart :: LimitedLinking className
aggregationWhole :: LimitedLinking className
..} ->
    LimitedLinking className -> Bool
forall a. LimitedLinking a -> Bool
validLimit LimitedLinking className
aggregationPart Bool -> Bool -> Bool
&& LimitedLinking className -> Bool
forall a. LimitedLinking a -> Bool
validLimit LimitedLinking className
aggregationWhole
  Composition {relationshipName
LimitedLinking className
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: relationshipName
compositionPart :: LimitedLinking className
compositionWhole :: LimitedLinking className
..} ->
    LimitedLinking className -> Bool
forall a. LimitedLinking a -> Bool
validLimit LimitedLinking className
compositionPart Bool -> Bool -> Bool
&& (Int, Maybe Int) -> Bool
forall {a}. (Ord a, Num a) => (a, Maybe a) -> Bool
validComposition (LimitedLinking className -> (Int, Maybe Int)
forall nodeName. LimitedLinking nodeName -> (Int, Maybe Int)
limits LimitedLinking className
compositionWhole)
  Inheritance {className
subClass :: forall className relationshipName.
Relationship className relationshipName -> className
superClass :: forall className relationshipName.
Relationship className relationshipName -> className
subClass :: className
superClass :: className
..} ->
    className
subClass className -> className -> Bool
forall a. Eq a => a -> a -> Bool
/= className
superClass
  where
    validLimit :: LimitedLinking nodeName -> Bool
validLimit = (Int, Maybe Int) -> Bool
forall {a}. (Ord a, Num a) => (a, Maybe a) -> Bool
validLimit' ((Int, Maybe Int) -> Bool)
-> (LimitedLinking nodeName -> (Int, Maybe Int))
-> LimitedLinking nodeName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LimitedLinking nodeName -> (Int, Maybe Int)
forall nodeName. LimitedLinking nodeName -> (Int, Maybe Int)
limits
    validLimit' :: (a, Maybe a) -> Bool
validLimit' (a
x, Maybe a
Nothing) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
    validLimit' (a
x, Just a
y) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
x
    validComposition :: (a, Maybe a) -> Bool
validComposition (a
_, Maybe a
Nothing) = Bool
False
    validComposition limit :: (a, Maybe a)
limit@(a
_, Just a
y) = a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1 Bool -> Bool -> Bool
&& (a, Maybe a) -> Bool
forall {a}. (Ord a, Num a) => (a, Maybe a) -> Bool
validLimit' (a, Maybe a)
limit

data Annotation annotation annotated = Annotation {
  forall annotation annotated.
Annotation annotation annotated -> annotated
annotated                   :: annotated,
  forall annotation annotated.
Annotation annotation annotated -> annotation
annotation                  :: annotation
  }
  deriving (Typeable (Annotation annotation annotated)
Typeable (Annotation annotation annotated)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> Annotation annotation annotated
    -> c (Annotation annotation annotated))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c (Annotation annotation annotated))
-> (Annotation annotation annotated -> Constr)
-> (Annotation annotation annotated -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (Annotation annotation annotated)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Annotation annotation annotated)))
-> ((forall b. Data b => b -> b)
    -> Annotation annotation annotated
    -> Annotation annotation annotated)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> Annotation annotation annotated
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> Annotation annotation annotated
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> Annotation annotation annotated -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> Annotation annotation annotated
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Annotation annotation annotated
    -> m (Annotation annotation annotated))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Annotation annotation annotated
    -> m (Annotation annotation annotated))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Annotation annotation annotated
    -> m (Annotation annotation annotated))
-> Data (Annotation annotation annotated)
Annotation annotation annotated -> Constr
Annotation annotation annotated -> DataType
(forall b. Data b => b -> b)
-> Annotation annotation annotated
-> Annotation annotation annotated
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> Annotation annotation annotated
-> u
forall u.
(forall d. Data d => d -> u)
-> Annotation annotation annotated -> [u]
forall {annotation} {annotated}.
(Data annotated, Data annotation) =>
Typeable (Annotation annotation annotated)
forall annotation annotated.
(Data annotated, Data annotation) =>
Annotation annotation annotated -> Constr
forall annotation annotated.
(Data annotated, Data annotation) =>
Annotation annotation annotated -> DataType
forall annotation annotated.
(Data annotated, Data annotation) =>
(forall b. Data b => b -> b)
-> Annotation annotation annotated
-> Annotation annotation annotated
forall annotation annotated u.
(Data annotated, Data annotation) =>
Int
-> (forall d. Data d => d -> u)
-> Annotation annotation annotated
-> u
forall annotation annotated u.
(Data annotated, Data annotation) =>
(forall d. Data d => d -> u)
-> Annotation annotation annotated -> [u]
forall annotation annotated r r'.
(Data annotated, Data annotation) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
forall annotation annotated r r'.
(Data annotated, Data annotation) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
forall annotation annotated (m :: * -> *).
(Data annotated, Data annotation, Monad m) =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
forall annotation annotated (m :: * -> *).
(Data annotated, Data annotation, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
forall annotation annotated (c :: * -> *).
(Data annotated, Data annotation) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Annotation annotation annotated)
forall annotation annotated (c :: * -> *).
(Data annotated, Data annotation) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Annotation annotation annotated
-> c (Annotation annotation annotated)
forall annotation annotated (t :: * -> *) (c :: * -> *).
(Data annotated, Data annotation, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (Annotation annotation annotated))
forall annotation annotated (t :: * -> * -> *) (c :: * -> *).
(Data annotated, Data annotation, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation annotation annotated))
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Annotation annotation annotated)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Annotation annotation annotated
-> c (Annotation annotation annotated)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (Annotation annotation annotated))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation annotation annotated))
$cgfoldl :: forall annotation annotated (c :: * -> *).
(Data annotated, Data annotation) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Annotation annotation annotated
-> c (Annotation annotation annotated)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Annotation annotation annotated
-> c (Annotation annotation annotated)
$cgunfold :: forall annotation annotated (c :: * -> *).
(Data annotated, Data annotation) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Annotation annotation annotated)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Annotation annotation annotated)
$ctoConstr :: forall annotation annotated.
(Data annotated, Data annotation) =>
Annotation annotation annotated -> Constr
toConstr :: Annotation annotation annotated -> Constr
$cdataTypeOf :: forall annotation annotated.
(Data annotated, Data annotation) =>
Annotation annotation annotated -> DataType
dataTypeOf :: Annotation annotation annotated -> DataType
$cdataCast1 :: forall annotation annotated (t :: * -> *) (c :: * -> *).
(Data annotated, Data annotation, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (Annotation annotation annotated))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (Annotation annotation annotated))
$cdataCast2 :: forall annotation annotated (t :: * -> * -> *) (c :: * -> *).
(Data annotated, Data annotation, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation annotation annotated))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Annotation annotation annotated))
$cgmapT :: forall annotation annotated.
(Data annotated, Data annotation) =>
(forall b. Data b => b -> b)
-> Annotation annotation annotated
-> Annotation annotation annotated
gmapT :: (forall b. Data b => b -> b)
-> Annotation annotation annotated
-> Annotation annotation annotated
$cgmapQl :: forall annotation annotated r r'.
(Data annotated, Data annotation) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
$cgmapQr :: forall annotation annotated r r'.
(Data annotated, Data annotation) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Annotation annotation annotated
-> r
$cgmapQ :: forall annotation annotated u.
(Data annotated, Data annotation) =>
(forall d. Data d => d -> u)
-> Annotation annotation annotated -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> Annotation annotation annotated -> [u]
$cgmapQi :: forall annotation annotated u.
(Data annotated, Data annotation) =>
Int
-> (forall d. Data d => d -> u)
-> Annotation annotation annotated
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> Annotation annotation annotated
-> u
$cgmapM :: forall annotation annotated (m :: * -> *).
(Data annotated, Data annotation, Monad m) =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
$cgmapMp :: forall annotation annotated (m :: * -> *).
(Data annotated, Data annotation, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
$cgmapMo :: forall annotation annotated (m :: * -> *).
(Data annotated, Data annotation, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Annotation annotation annotated
-> m (Annotation annotation annotated)
Data, Annotation annotation annotated
-> Annotation annotation annotated -> Bool
(Annotation annotation annotated
 -> Annotation annotation annotated -> Bool)
-> (Annotation annotation annotated
    -> Annotation annotation annotated -> Bool)
-> Eq (Annotation annotation annotated)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall annotation annotated.
(Eq annotated, Eq annotation) =>
Annotation annotation annotated
-> Annotation annotation annotated -> Bool
$c== :: forall annotation annotated.
(Eq annotated, Eq annotation) =>
Annotation annotation annotated
-> Annotation annotation annotated -> Bool
== :: Annotation annotation annotated
-> Annotation annotation annotated -> Bool
$c/= :: forall annotation annotated.
(Eq annotated, Eq annotation) =>
Annotation annotation annotated
-> Annotation annotation annotated -> Bool
/= :: Annotation annotation annotated
-> Annotation annotation annotated -> Bool
Eq, (forall m. Monoid m => Annotation annotation m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> Annotation annotation a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> Annotation annotation a -> m)
-> (forall a b. (a -> b -> b) -> b -> Annotation annotation a -> b)
-> (forall a b. (a -> b -> b) -> b -> Annotation annotation a -> b)
-> (forall b a. (b -> a -> b) -> b -> Annotation annotation a -> b)
-> (forall b a. (b -> a -> b) -> b -> Annotation annotation a -> b)
-> (forall a. (a -> a -> a) -> Annotation annotation a -> a)
-> (forall a. (a -> a -> a) -> Annotation annotation a -> a)
-> (forall a. Annotation annotation a -> [a])
-> (forall a. Annotation annotation a -> Bool)
-> (forall a. Annotation annotation a -> Int)
-> (forall a. Eq a => a -> Annotation annotation a -> Bool)
-> (forall a. Ord a => Annotation annotation a -> a)
-> (forall a. Ord a => Annotation annotation a -> a)
-> (forall a. Num a => Annotation annotation a -> a)
-> (forall a. Num a => Annotation annotation a -> a)
-> Foldable (Annotation annotation)
forall a. Eq a => a -> Annotation annotation a -> Bool
forall a. Num a => Annotation annotation a -> a
forall a. Ord a => Annotation annotation a -> a
forall m. Monoid m => Annotation annotation m -> m
forall a. Annotation annotation a -> Bool
forall a. Annotation annotation a -> Int
forall a. Annotation annotation a -> [a]
forall a. (a -> a -> a) -> Annotation annotation a -> a
forall annotation a. Eq a => a -> Annotation annotation a -> Bool
forall annotation a. Num a => Annotation annotation a -> a
forall annotation a. Ord a => Annotation annotation a -> a
forall m a. Monoid m => (a -> m) -> Annotation annotation a -> m
forall annotation m. Monoid m => Annotation annotation m -> m
forall annotation a. Annotation annotation a -> Bool
forall annotation a. Annotation annotation a -> Int
forall annotation a. Annotation annotation a -> [a]
forall b a. (b -> a -> b) -> b -> Annotation annotation a -> b
forall a b. (a -> b -> b) -> b -> Annotation annotation a -> b
forall annotation a. (a -> a -> a) -> Annotation annotation a -> a
forall annotation m a.
Monoid m =>
(a -> m) -> Annotation annotation a -> m
forall annotation b a.
(b -> a -> b) -> b -> Annotation annotation a -> b
forall annotation a b.
(a -> b -> b) -> b -> Annotation annotation a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall annotation m. Monoid m => Annotation annotation m -> m
fold :: forall m. Monoid m => Annotation annotation m -> m
$cfoldMap :: forall annotation m a.
Monoid m =>
(a -> m) -> Annotation annotation a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Annotation annotation a -> m
$cfoldMap' :: forall annotation m a.
Monoid m =>
(a -> m) -> Annotation annotation a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Annotation annotation a -> m
$cfoldr :: forall annotation a b.
(a -> b -> b) -> b -> Annotation annotation a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Annotation annotation a -> b
$cfoldr' :: forall annotation a b.
(a -> b -> b) -> b -> Annotation annotation a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Annotation annotation a -> b
$cfoldl :: forall annotation b a.
(b -> a -> b) -> b -> Annotation annotation a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Annotation annotation a -> b
$cfoldl' :: forall annotation b a.
(b -> a -> b) -> b -> Annotation annotation a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Annotation annotation a -> b
$cfoldr1 :: forall annotation a. (a -> a -> a) -> Annotation annotation a -> a
foldr1 :: forall a. (a -> a -> a) -> Annotation annotation a -> a
$cfoldl1 :: forall annotation a. (a -> a -> a) -> Annotation annotation a -> a
foldl1 :: forall a. (a -> a -> a) -> Annotation annotation a -> a
$ctoList :: forall annotation a. Annotation annotation a -> [a]
toList :: forall a. Annotation annotation a -> [a]
$cnull :: forall annotation a. Annotation annotation a -> Bool
null :: forall a. Annotation annotation a -> Bool
$clength :: forall annotation a. Annotation annotation a -> Int
length :: forall a. Annotation annotation a -> Int
$celem :: forall annotation a. Eq a => a -> Annotation annotation a -> Bool
elem :: forall a. Eq a => a -> Annotation annotation a -> Bool
$cmaximum :: forall annotation a. Ord a => Annotation annotation a -> a
maximum :: forall a. Ord a => Annotation annotation a -> a
$cminimum :: forall annotation a. Ord a => Annotation annotation a -> a
minimum :: forall a. Ord a => Annotation annotation a -> a
$csum :: forall annotation a. Num a => Annotation annotation a -> a
sum :: forall a. Num a => Annotation annotation a -> a
$cproduct :: forall annotation a. Num a => Annotation annotation a -> a
product :: forall a. Num a => Annotation annotation a -> a
Foldable, (forall a b.
 (a -> b) -> Annotation annotation a -> Annotation annotation b)
-> (forall a b.
    a -> Annotation annotation b -> Annotation annotation a)
-> Functor (Annotation annotation)
forall a b. a -> Annotation annotation b -> Annotation annotation a
forall a b.
(a -> b) -> Annotation annotation a -> Annotation annotation b
forall annotation a b.
a -> Annotation annotation b -> Annotation annotation a
forall annotation a b.
(a -> b) -> Annotation annotation a -> Annotation annotation b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall annotation a b.
(a -> b) -> Annotation annotation a -> Annotation annotation b
fmap :: forall a b.
(a -> b) -> Annotation annotation a -> Annotation annotation b
$c<$ :: forall annotation a b.
a -> Annotation annotation b -> Annotation annotation a
<$ :: forall a b. a -> Annotation annotation b -> Annotation annotation a
Functor, (forall x.
 Annotation annotation annotated
 -> Rep (Annotation annotation annotated) x)
-> (forall x.
    Rep (Annotation annotation annotated) x
    -> Annotation annotation annotated)
-> Generic (Annotation annotation annotated)
forall x.
Rep (Annotation annotation annotated) x
-> Annotation annotation annotated
forall x.
Annotation annotation annotated
-> Rep (Annotation annotation annotated) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall annotation annotated x.
Rep (Annotation annotation annotated) x
-> Annotation annotation annotated
forall annotation annotated x.
Annotation annotation annotated
-> Rep (Annotation annotation annotated) x
$cfrom :: forall annotation annotated x.
Annotation annotation annotated
-> Rep (Annotation annotation annotated) x
from :: forall x.
Annotation annotation annotated
-> Rep (Annotation annotation annotated) x
$cto :: forall annotation annotated x.
Rep (Annotation annotation annotated) x
-> Annotation annotation annotated
to :: forall x.
Rep (Annotation annotation annotated) x
-> Annotation annotation annotated
Generic, ReadPrec [Annotation annotation annotated]
ReadPrec (Annotation annotation annotated)
Int -> ReadS (Annotation annotation annotated)
ReadS [Annotation annotation annotated]
(Int -> ReadS (Annotation annotation annotated))
-> ReadS [Annotation annotation annotated]
-> ReadPrec (Annotation annotation annotated)
-> ReadPrec [Annotation annotation annotated]
-> Read (Annotation annotation annotated)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall annotation annotated.
(Read annotated, Read annotation) =>
ReadPrec [Annotation annotation annotated]
forall annotation annotated.
(Read annotated, Read annotation) =>
ReadPrec (Annotation annotation annotated)
forall annotation annotated.
(Read annotated, Read annotation) =>
Int -> ReadS (Annotation annotation annotated)
forall annotation annotated.
(Read annotated, Read annotation) =>
ReadS [Annotation annotation annotated]
$creadsPrec :: forall annotation annotated.
(Read annotated, Read annotation) =>
Int -> ReadS (Annotation annotation annotated)
readsPrec :: Int -> ReadS (Annotation annotation annotated)
$creadList :: forall annotation annotated.
(Read annotated, Read annotation) =>
ReadS [Annotation annotation annotated]
readList :: ReadS [Annotation annotation annotated]
$creadPrec :: forall annotation annotated.
(Read annotated, Read annotation) =>
ReadPrec (Annotation annotation annotated)
readPrec :: ReadPrec (Annotation annotation annotated)
$creadListPrec :: forall annotation annotated.
(Read annotated, Read annotation) =>
ReadPrec [Annotation annotation annotated]
readListPrec :: ReadPrec [Annotation annotation annotated]
Read, Int -> Annotation annotation annotated -> ShowS
[Annotation annotation annotated] -> ShowS
Annotation annotation annotated -> String
(Int -> Annotation annotation annotated -> ShowS)
-> (Annotation annotation annotated -> String)
-> ([Annotation annotation annotated] -> ShowS)
-> Show (Annotation annotation annotated)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall annotation annotated.
(Show annotated, Show annotation) =>
Int -> Annotation annotation annotated -> ShowS
forall annotation annotated.
(Show annotated, Show annotation) =>
[Annotation annotation annotated] -> ShowS
forall annotation annotated.
(Show annotated, Show annotation) =>
Annotation annotation annotated -> String
$cshowsPrec :: forall annotation annotated.
(Show annotated, Show annotation) =>
Int -> Annotation annotation annotated -> ShowS
showsPrec :: Int -> Annotation annotation annotated -> ShowS
$cshow :: forall annotation annotated.
(Show annotated, Show annotation) =>
Annotation annotation annotated -> String
show :: Annotation annotation annotated -> String
$cshowList :: forall annotation annotated.
(Show annotated, Show annotation) =>
[Annotation annotation annotated] -> ShowS
showList :: [Annotation annotation annotated] -> ShowS
Show, Functor (Annotation annotation)
Foldable (Annotation annotation)
Functor (Annotation annotation)
-> Foldable (Annotation annotation)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> Annotation annotation a -> f (Annotation annotation b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Annotation annotation (f a) -> f (Annotation annotation a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> Annotation annotation a -> m (Annotation annotation b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Annotation annotation (m a) -> m (Annotation annotation a))
-> Traversable (Annotation annotation)
forall annotation. Functor (Annotation annotation)
forall annotation. Foldable (Annotation annotation)
forall annotation (m :: * -> *) a.
Monad m =>
Annotation annotation (m a) -> m (Annotation annotation a)
forall annotation (f :: * -> *) a.
Applicative f =>
Annotation annotation (f a) -> f (Annotation annotation a)
forall annotation (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Annotation annotation a -> m (Annotation annotation b)
forall annotation (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Annotation annotation a -> f (Annotation annotation b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Annotation annotation (m a) -> m (Annotation annotation a)
forall (f :: * -> *) a.
Applicative f =>
Annotation annotation (f a) -> f (Annotation annotation a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Annotation annotation a -> m (Annotation annotation b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Annotation annotation a -> f (Annotation annotation b)
$ctraverse :: forall annotation (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Annotation annotation a -> f (Annotation annotation b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Annotation annotation a -> f (Annotation annotation b)
$csequenceA :: forall annotation (f :: * -> *) a.
Applicative f =>
Annotation annotation (f a) -> f (Annotation annotation a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Annotation annotation (f a) -> f (Annotation annotation a)
$cmapM :: forall annotation (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Annotation annotation a -> m (Annotation annotation b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Annotation annotation a -> m (Annotation annotation b)
$csequence :: forall annotation (m :: * -> *) a.
Monad m =>
Annotation annotation (m a) -> m (Annotation annotation a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Annotation annotation (m a) -> m (Annotation annotation a)
Traversable)

$(deriveBifunctor ''Annotation)
$(deriveBifoldable ''Annotation)
$(deriveBitraversable ''Annotation)

data AnnotatedClassDiagram relationshipAnnotation className relationshipName
  = AnnotatedClassDiagram {
    forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [className]
annotatedClasses
      :: [className],
    forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [Annotation
      relationshipAnnotation
      (AnyRelationship className relationshipName)]
annotatedRelationships
      :: [Annotation relationshipAnnotation (AnyRelationship className relationshipName)]
    }
  deriving (Typeable
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
Typeable
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> c (AnnotatedClassDiagram
            relationshipAnnotation className relationshipName))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c (AnnotatedClassDiagram
            relationshipAnnotation className relationshipName))
-> (AnnotatedClassDiagram
      relationshipAnnotation className relationshipName
    -> Constr)
-> (AnnotatedClassDiagram
      relationshipAnnotation className relationshipName
    -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe
         (c (AnnotatedClassDiagram
               relationshipAnnotation className relationshipName)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe
         (c (AnnotatedClassDiagram
               relationshipAnnotation className relationshipName)))
-> ((forall b. Data b => b -> b)
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> m (AnnotatedClassDiagram
            relationshipAnnotation className relationshipName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> m (AnnotatedClassDiagram
            relationshipAnnotation className relationshipName))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> m (AnnotatedClassDiagram
            relationshipAnnotation className relationshipName))
-> Data
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Constr
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> DataType
(forall b. Data b => b -> b)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> u
forall u.
(forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
forall {relationshipAnnotation} {className} {relationshipName}.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
Typeable
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
forall relationshipAnnotation className relationshipName.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Constr
forall relationshipAnnotation className relationshipName.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> DataType
forall relationshipAnnotation className relationshipName.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall b. Data b => b -> b)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
forall relationshipAnnotation className relationshipName u.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
Int
-> (forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> u
forall relationshipAnnotation className relationshipName u.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> [u]
forall relationshipAnnotation className relationshipName r r'.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
forall relationshipAnnotation className relationshipName r r'.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
forall relationshipAnnotation className relationshipName
       (m :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, Monad m) =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall relationshipAnnotation className relationshipName
       (m :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall relationshipAnnotation className relationshipName
       (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall relationshipAnnotation className relationshipName
       (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall relationshipAnnotation className relationshipName
       (t :: * -> *) (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
forall relationshipAnnotation className relationshipName
       (t :: * -> * -> *) (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
$cgfoldl :: forall relationshipAnnotation className relationshipName
       (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
$cgunfold :: forall relationshipAnnotation className relationshipName
       (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
$ctoConstr :: forall relationshipAnnotation className relationshipName.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Constr
toConstr :: AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Constr
$cdataTypeOf :: forall relationshipAnnotation className relationshipName.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> DataType
dataTypeOf :: AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> DataType
$cdataCast1 :: forall relationshipAnnotation className relationshipName
       (t :: * -> *) (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
$cdataCast2 :: forall relationshipAnnotation className relationshipName
       (t :: * -> * -> *) (c :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe
     (c (AnnotatedClassDiagram
           relationshipAnnotation className relationshipName))
$cgmapT :: forall relationshipAnnotation className relationshipName.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall b. Data b => b -> b)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
gmapT :: (forall b. Data b => b -> b)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
$cgmapQl :: forall relationshipAnnotation className relationshipName r r'.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
$cgmapQr :: forall relationshipAnnotation className relationshipName r r'.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> r
$cgmapQ :: forall relationshipAnnotation className relationshipName u.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
(forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> [u]
$cgmapQi :: forall relationshipAnnotation className relationshipName u.
(Data relationshipAnnotation, Data className,
 Data relationshipName) =>
Int
-> (forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> u
$cgmapM :: forall relationshipAnnotation className relationshipName
       (m :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, Monad m) =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
$cgmapMp :: forall relationshipAnnotation className relationshipName
       (m :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
$cgmapMo :: forall relationshipAnnotation className relationshipName
       (m :: * -> *).
(Data relationshipAnnotation, Data className,
 Data relationshipName, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> m (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
Data, AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> Bool
(AnnotatedClassDiagram
   relationshipAnnotation className relationshipName
 -> AnnotatedClassDiagram
      relationshipAnnotation className relationshipName
 -> Bool)
-> (AnnotatedClassDiagram
      relationshipAnnotation className relationshipName
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName
    -> Bool)
-> Eq
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall relationshipAnnotation className relationshipName.
(Eq className, Eq relationshipName, Eq relationshipAnnotation) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> Bool
$c== :: forall relationshipAnnotation className relationshipName.
(Eq className, Eq relationshipName, Eq relationshipAnnotation) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> Bool
== :: AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> Bool
$c/= :: forall relationshipAnnotation className relationshipName.
(Eq className, Eq relationshipName, Eq relationshipAnnotation) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> Bool
/= :: AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> Bool
Eq, (forall x.
 AnnotatedClassDiagram
   relationshipAnnotation className relationshipName
 -> Rep
      (AnnotatedClassDiagram
         relationshipAnnotation className relationshipName)
      x)
-> (forall x.
    Rep
      (AnnotatedClassDiagram
         relationshipAnnotation className relationshipName)
      x
    -> AnnotatedClassDiagram
         relationshipAnnotation className relationshipName)
-> Generic
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall x.
Rep
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
  x
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
forall x.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Rep
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
     x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall relationshipAnnotation className relationshipName x.
Rep
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
  x
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
forall relationshipAnnotation className relationshipName x.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Rep
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
     x
$cfrom :: forall relationshipAnnotation className relationshipName x.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Rep
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
     x
from :: forall x.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> Rep
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
     x
$cto :: forall relationshipAnnotation className relationshipName x.
Rep
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
  x
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
to :: forall x.
Rep
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
  x
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
Generic, ReadPrec
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
ReadPrec
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
Int
-> ReadS
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
ReadS
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
(Int
 -> ReadS
      (AnnotatedClassDiagram
         relationshipAnnotation className relationshipName))
-> ReadS
     [AnnotatedClassDiagram
        relationshipAnnotation className relationshipName]
-> ReadPrec
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
-> ReadPrec
     [AnnotatedClassDiagram
        relationshipAnnotation className relationshipName]
-> Read
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
ReadPrec
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
ReadPrec
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
Int
-> ReadS
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
ReadS
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
$creadsPrec :: forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
Int
-> ReadS
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
readsPrec :: Int
-> ReadS
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
$creadList :: forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
ReadS
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
readList :: ReadS
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
$creadPrec :: forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
ReadPrec
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
readPrec :: ReadPrec
  (AnnotatedClassDiagram
     relationshipAnnotation className relationshipName)
$creadListPrec :: forall relationshipAnnotation className relationshipName.
(Read className, Read relationshipName,
 Read relationshipAnnotation) =>
ReadPrec
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
readListPrec :: ReadPrec
  [AnnotatedClassDiagram
     relationshipAnnotation className relationshipName]
Read, Int
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> ShowS
[AnnotatedClassDiagram
   relationshipAnnotation className relationshipName]
-> ShowS
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> String
(Int
 -> AnnotatedClassDiagram
      relationshipAnnotation className relationshipName
 -> ShowS)
-> (AnnotatedClassDiagram
      relationshipAnnotation className relationshipName
    -> String)
-> ([AnnotatedClassDiagram
       relationshipAnnotation className relationshipName]
    -> ShowS)
-> Show
     (AnnotatedClassDiagram
        relationshipAnnotation className relationshipName)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall relationshipAnnotation className relationshipName.
(Show className, Show relationshipName,
 Show relationshipAnnotation) =>
Int
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> ShowS
forall relationshipAnnotation className relationshipName.
(Show className, Show relationshipName,
 Show relationshipAnnotation) =>
[AnnotatedClassDiagram
   relationshipAnnotation className relationshipName]
-> ShowS
forall relationshipAnnotation className relationshipName.
(Show className, Show relationshipName,
 Show relationshipAnnotation) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> String
$cshowsPrec :: forall relationshipAnnotation className relationshipName.
(Show className, Show relationshipName,
 Show relationshipAnnotation) =>
Int
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> ShowS
showsPrec :: Int
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
-> ShowS
$cshow :: forall relationshipAnnotation className relationshipName.
(Show className, Show relationshipName,
 Show relationshipAnnotation) =>
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> String
show :: AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> String
$cshowList :: forall relationshipAnnotation className relationshipName.
(Show className, Show relationshipName,
 Show relationshipAnnotation) =>
[AnnotatedClassDiagram
   relationshipAnnotation className relationshipName]
-> ShowS
showList :: [AnnotatedClassDiagram
   relationshipAnnotation className relationshipName]
-> ShowS
Show)

instance Functor (AnnotatedClassDiagram relationshipAnnotation className) where
  fmap :: forall a b.
(a -> b)
-> AnnotatedClassDiagram relationshipAnnotation className a
-> AnnotatedClassDiagram relationshipAnnotation className b
fmap a -> b
f AnnotatedClassDiagram {[className]
[Annotation relationshipAnnotation (AnyRelationship className a)]
annotatedClasses :: forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [className]
annotatedRelationships :: forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [Annotation
      relationshipAnnotation
      (AnyRelationship className relationshipName)]
annotatedClasses :: [className]
annotatedRelationships :: [Annotation relationshipAnnotation (AnyRelationship className a)]
..} = AnnotatedClassDiagram {
    annotatedClasses :: [className]
annotatedClasses = [className]
annotatedClasses,
    annotatedRelationships :: [Annotation relationshipAnnotation (AnyRelationship className b)]
annotatedRelationships = (Annotation relationshipAnnotation (AnyRelationship className a)
 -> Annotation relationshipAnnotation (AnyRelationship className b))
-> [Annotation
      relationshipAnnotation (AnyRelationship className a)]
-> [Annotation
      relationshipAnnotation (AnyRelationship className b)]
forall a b. (a -> b) -> [a] -> [b]
map
      ((AnyRelationship className a -> AnyRelationship className b)
-> Annotation relationshipAnnotation (AnyRelationship className a)
-> Annotation relationshipAnnotation (AnyRelationship className b)
forall a b.
(a -> b)
-> Annotation relationshipAnnotation a
-> Annotation relationshipAnnotation b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AnyRelationship className a -> AnyRelationship className b)
 -> Annotation relationshipAnnotation (AnyRelationship className a)
 -> Annotation relationshipAnnotation (AnyRelationship className b))
-> (AnyRelationship className a -> AnyRelationship className b)
-> Annotation relationshipAnnotation (AnyRelationship className a)
-> Annotation relationshipAnnotation (AnyRelationship className b)
forall a b. (a -> b) -> a -> b
$ (InvalidRelationship className a
 -> InvalidRelationship className b)
-> (Relationship className a -> Relationship className b)
-> AnyRelationship className a
-> AnyRelationship className b
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
forall a b.
(a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((a -> b) -> Relationship className a -> Relationship className b
forall a b.
(a -> b) -> Relationship className a -> Relationship className b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f))
      [Annotation relationshipAnnotation (AnyRelationship className a)]
annotatedRelationships
    }

$(deriveBifunctor ''AnnotatedClassDiagram)
$(deriveBifoldable ''AnnotatedClassDiagram)
$(deriveBitraversable ''AnnotatedClassDiagram)

unannotateCd
  :: AnnotatedClassDiagram relationshipAnnotation className relationshipName
  -> AnyClassDiagram className relationshipName
unannotateCd :: forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> AnyClassDiagram className relationshipName
unannotateCd AnnotatedClassDiagram {[className]
[Annotation
   relationshipAnnotation
   (AnyRelationship className relationshipName)]
annotatedClasses :: forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [className]
annotatedRelationships :: forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [Annotation
      relationshipAnnotation
      (AnyRelationship className relationshipName)]
annotatedClasses :: [className]
annotatedRelationships :: [Annotation
   relationshipAnnotation
   (AnyRelationship className relationshipName)]
..} = AnyClassDiagram {
  anyClassNames :: [className]
anyClassNames = [className]
annotatedClasses,
  anyRelationships :: [AnyRelationship className relationshipName]
anyRelationships = (Annotation
   relationshipAnnotation (AnyRelationship className relationshipName)
 -> AnyRelationship className relationshipName)
-> [Annotation
      relationshipAnnotation
      (AnyRelationship className relationshipName)]
-> [AnyRelationship className relationshipName]
forall a b. (a -> b) -> [a] -> [b]
map Annotation
  relationshipAnnotation (AnyRelationship className relationshipName)
-> AnyRelationship className relationshipName
forall annotation annotated.
Annotation annotation annotated -> annotated
annotated [Annotation
   relationshipAnnotation
   (AnyRelationship className relationshipName)]
annotatedRelationships
  }

data ClassDiagram className relationshipName = ClassDiagram {
  forall className relationshipName.
ClassDiagram className relationshipName -> [className]
classNames                  :: [className],
  forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships               :: [Relationship className relationshipName]
  }
  deriving (ClassDiagram className relationshipName
-> ClassDiagram className relationshipName -> Bool
(ClassDiagram className relationshipName
 -> ClassDiagram className relationshipName -> Bool)
-> (ClassDiagram className relationshipName
    -> ClassDiagram className relationshipName -> Bool)
-> Eq (ClassDiagram className relationshipName)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall className relationshipName.
(Eq className, Eq relationshipName) =>
ClassDiagram className relationshipName
-> ClassDiagram className relationshipName -> Bool
$c== :: forall className relationshipName.
(Eq className, Eq relationshipName) =>
ClassDiagram className relationshipName
-> ClassDiagram className relationshipName -> Bool
== :: ClassDiagram className relationshipName
-> ClassDiagram className relationshipName -> Bool
$c/= :: forall className relationshipName.
(Eq className, Eq relationshipName) =>
ClassDiagram className relationshipName
-> ClassDiagram className relationshipName -> Bool
/= :: ClassDiagram className relationshipName
-> ClassDiagram className relationshipName -> Bool
Eq, (forall a b.
 (a -> b) -> ClassDiagram className a -> ClassDiagram className b)
-> (forall a b.
    a -> ClassDiagram className b -> ClassDiagram className a)
-> Functor (ClassDiagram className)
forall a b.
a -> ClassDiagram className b -> ClassDiagram className a
forall a b.
(a -> b) -> ClassDiagram className a -> ClassDiagram className b
forall className a b.
a -> ClassDiagram className b -> ClassDiagram className a
forall className a b.
(a -> b) -> ClassDiagram className a -> ClassDiagram className b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall className a b.
(a -> b) -> ClassDiagram className a -> ClassDiagram className b
fmap :: forall a b.
(a -> b) -> ClassDiagram className a -> ClassDiagram className b
$c<$ :: forall className a b.
a -> ClassDiagram className b -> ClassDiagram className a
<$ :: forall a b.
a -> ClassDiagram className b -> ClassDiagram className a
Functor, (forall x.
 ClassDiagram className relationshipName
 -> Rep (ClassDiagram className relationshipName) x)
-> (forall x.
    Rep (ClassDiagram className relationshipName) x
    -> ClassDiagram className relationshipName)
-> Generic (ClassDiagram className relationshipName)
forall x.
Rep (ClassDiagram className relationshipName) x
-> ClassDiagram className relationshipName
forall x.
ClassDiagram className relationshipName
-> Rep (ClassDiagram className relationshipName) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall className relationshipName x.
Rep (ClassDiagram className relationshipName) x
-> ClassDiagram className relationshipName
forall className relationshipName x.
ClassDiagram className relationshipName
-> Rep (ClassDiagram className relationshipName) x
$cfrom :: forall className relationshipName x.
ClassDiagram className relationshipName
-> Rep (ClassDiagram className relationshipName) x
from :: forall x.
ClassDiagram className relationshipName
-> Rep (ClassDiagram className relationshipName) x
$cto :: forall className relationshipName x.
Rep (ClassDiagram className relationshipName) x
-> ClassDiagram className relationshipName
to :: forall x.
Rep (ClassDiagram className relationshipName) x
-> ClassDiagram className relationshipName
Generic, ReadPrec [ClassDiagram className relationshipName]
ReadPrec (ClassDiagram className relationshipName)
Int -> ReadS (ClassDiagram className relationshipName)
ReadS [ClassDiagram className relationshipName]
(Int -> ReadS (ClassDiagram className relationshipName))
-> ReadS [ClassDiagram className relationshipName]
-> ReadPrec (ClassDiagram className relationshipName)
-> ReadPrec [ClassDiagram className relationshipName]
-> Read (ClassDiagram className relationshipName)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec [ClassDiagram className relationshipName]
forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec (ClassDiagram className relationshipName)
forall className relationshipName.
(Read className, Read relationshipName) =>
Int -> ReadS (ClassDiagram className relationshipName)
forall className relationshipName.
(Read className, Read relationshipName) =>
ReadS [ClassDiagram className relationshipName]
$creadsPrec :: forall className relationshipName.
(Read className, Read relationshipName) =>
Int -> ReadS (ClassDiagram className relationshipName)
readsPrec :: Int -> ReadS (ClassDiagram className relationshipName)
$creadList :: forall className relationshipName.
(Read className, Read relationshipName) =>
ReadS [ClassDiagram className relationshipName]
readList :: ReadS [ClassDiagram className relationshipName]
$creadPrec :: forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec (ClassDiagram className relationshipName)
readPrec :: ReadPrec (ClassDiagram className relationshipName)
$creadListPrec :: forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec [ClassDiagram className relationshipName]
readListPrec :: ReadPrec [ClassDiagram className relationshipName]
Read, Int -> ClassDiagram className relationshipName -> ShowS
[ClassDiagram className relationshipName] -> ShowS
ClassDiagram className relationshipName -> String
(Int -> ClassDiagram className relationshipName -> ShowS)
-> (ClassDiagram className relationshipName -> String)
-> ([ClassDiagram className relationshipName] -> ShowS)
-> Show (ClassDiagram className relationshipName)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall className relationshipName.
(Show className, Show relationshipName) =>
Int -> ClassDiagram className relationshipName -> ShowS
forall className relationshipName.
(Show className, Show relationshipName) =>
[ClassDiagram className relationshipName] -> ShowS
forall className relationshipName.
(Show className, Show relationshipName) =>
ClassDiagram className relationshipName -> String
$cshowsPrec :: forall className relationshipName.
(Show className, Show relationshipName) =>
Int -> ClassDiagram className relationshipName -> ShowS
showsPrec :: Int -> ClassDiagram className relationshipName -> ShowS
$cshow :: forall className relationshipName.
(Show className, Show relationshipName) =>
ClassDiagram className relationshipName -> String
show :: ClassDiagram className relationshipName -> String
$cshowList :: forall className relationshipName.
(Show className, Show relationshipName) =>
[ClassDiagram className relationshipName] -> ShowS
showList :: [ClassDiagram className relationshipName] -> ShowS
Show)

instance Bifunctor ClassDiagram where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> ClassDiagram a c -> ClassDiagram b d
bimap a -> b
f c -> d
g ClassDiagram {[a]
[Relationship a c]
classNames :: forall className relationshipName.
ClassDiagram className relationshipName -> [className]
relationships :: forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
classNames :: [a]
relationships :: [Relationship a c]
..} = ClassDiagram {
    classNames :: [b]
classNames  = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
classNames,
    relationships :: [Relationship b d]
relationships = (Relationship a c -> Relationship b d)
-> [Relationship a c] -> [Relationship b d]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (c -> d) -> Relationship a c -> Relationship b d
forall a b c d.
(a -> b) -> (c -> d) -> Relationship a c -> Relationship b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) [Relationship a c]
relationships
    }

instance Bifoldable ClassDiagram where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> ClassDiagram a b -> m
bifoldMap a -> m
f b -> m
g ClassDiagram {[a]
[Relationship a b]
classNames :: forall className relationshipName.
ClassDiagram className relationshipName -> [className]
relationships :: forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
classNames :: [a]
relationships :: [Relationship a b]
..} = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
classNames
    m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Relationship a b -> m) -> [Relationship a b] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Relationship a b -> m
forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Relationship a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) [Relationship a b]
relationships

instance Bitraversable ClassDiagram where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> ClassDiagram a b -> f (ClassDiagram c d)
bitraverse a -> f c
f b -> f d
g ClassDiagram {[a]
[Relationship a b]
classNames :: forall className relationshipName.
ClassDiagram className relationshipName -> [className]
relationships :: forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
classNames :: [a]
relationships :: [Relationship a b]
..} = [c] -> [Relationship c d] -> ClassDiagram c d
forall className relationshipName.
[className]
-> [Relationship className relationshipName]
-> ClassDiagram className relationshipName
ClassDiagram
    ([c] -> [Relationship c d] -> ClassDiagram c d)
-> f [c] -> f ([Relationship c d] -> ClassDiagram c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> [a] -> f [c]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> f c
f [a]
classNames
    f ([Relationship c d] -> ClassDiagram c d)
-> f [Relationship c d] -> f (ClassDiagram c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Relationship a b -> f (Relationship c d))
-> [Relationship a b] -> f [Relationship c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f c)
-> (b -> f d) -> Relationship a b -> f (Relationship c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> Relationship a b -> f (Relationship c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) [Relationship a b]
relationships

data AnyClassDiagram className relationshipName = AnyClassDiagram {
  forall className relationshipName.
AnyClassDiagram className relationshipName -> [className]
anyClassNames           :: ![className],
  forall className relationshipName.
AnyClassDiagram className relationshipName
-> [AnyRelationship className relationshipName]
anyRelationships        :: ![AnyRelationship className relationshipName]
  }
  deriving (AnyClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName -> Bool
(AnyClassDiagram className relationshipName
 -> AnyClassDiagram className relationshipName -> Bool)
-> (AnyClassDiagram className relationshipName
    -> AnyClassDiagram className relationshipName -> Bool)
-> Eq (AnyClassDiagram className relationshipName)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall className relationshipName.
(Eq className, Eq relationshipName) =>
AnyClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName -> Bool
$c== :: forall className relationshipName.
(Eq className, Eq relationshipName) =>
AnyClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName -> Bool
== :: AnyClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName -> Bool
$c/= :: forall className relationshipName.
(Eq className, Eq relationshipName) =>
AnyClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName -> Bool
/= :: AnyClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName -> Bool
Eq, (forall x.
 AnyClassDiagram className relationshipName
 -> Rep (AnyClassDiagram className relationshipName) x)
-> (forall x.
    Rep (AnyClassDiagram className relationshipName) x
    -> AnyClassDiagram className relationshipName)
-> Generic (AnyClassDiagram className relationshipName)
forall x.
Rep (AnyClassDiagram className relationshipName) x
-> AnyClassDiagram className relationshipName
forall x.
AnyClassDiagram className relationshipName
-> Rep (AnyClassDiagram className relationshipName) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall className relationshipName x.
Rep (AnyClassDiagram className relationshipName) x
-> AnyClassDiagram className relationshipName
forall className relationshipName x.
AnyClassDiagram className relationshipName
-> Rep (AnyClassDiagram className relationshipName) x
$cfrom :: forall className relationshipName x.
AnyClassDiagram className relationshipName
-> Rep (AnyClassDiagram className relationshipName) x
from :: forall x.
AnyClassDiagram className relationshipName
-> Rep (AnyClassDiagram className relationshipName) x
$cto :: forall className relationshipName x.
Rep (AnyClassDiagram className relationshipName) x
-> AnyClassDiagram className relationshipName
to :: forall x.
Rep (AnyClassDiagram className relationshipName) x
-> AnyClassDiagram className relationshipName
Generic, ReadPrec [AnyClassDiagram className relationshipName]
ReadPrec (AnyClassDiagram className relationshipName)
Int -> ReadS (AnyClassDiagram className relationshipName)
ReadS [AnyClassDiagram className relationshipName]
(Int -> ReadS (AnyClassDiagram className relationshipName))
-> ReadS [AnyClassDiagram className relationshipName]
-> ReadPrec (AnyClassDiagram className relationshipName)
-> ReadPrec [AnyClassDiagram className relationshipName]
-> Read (AnyClassDiagram className relationshipName)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec [AnyClassDiagram className relationshipName]
forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec (AnyClassDiagram className relationshipName)
forall className relationshipName.
(Read className, Read relationshipName) =>
Int -> ReadS (AnyClassDiagram className relationshipName)
forall className relationshipName.
(Read className, Read relationshipName) =>
ReadS [AnyClassDiagram className relationshipName]
$creadsPrec :: forall className relationshipName.
(Read className, Read relationshipName) =>
Int -> ReadS (AnyClassDiagram className relationshipName)
readsPrec :: Int -> ReadS (AnyClassDiagram className relationshipName)
$creadList :: forall className relationshipName.
(Read className, Read relationshipName) =>
ReadS [AnyClassDiagram className relationshipName]
readList :: ReadS [AnyClassDiagram className relationshipName]
$creadPrec :: forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec (AnyClassDiagram className relationshipName)
readPrec :: ReadPrec (AnyClassDiagram className relationshipName)
$creadListPrec :: forall className relationshipName.
(Read className, Read relationshipName) =>
ReadPrec [AnyClassDiagram className relationshipName]
readListPrec :: ReadPrec [AnyClassDiagram className relationshipName]
Read, Int -> AnyClassDiagram className relationshipName -> ShowS
[AnyClassDiagram className relationshipName] -> ShowS
AnyClassDiagram className relationshipName -> String
(Int -> AnyClassDiagram className relationshipName -> ShowS)
-> (AnyClassDiagram className relationshipName -> String)
-> ([AnyClassDiagram className relationshipName] -> ShowS)
-> Show (AnyClassDiagram className relationshipName)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall className relationshipName.
(Show className, Show relationshipName) =>
Int -> AnyClassDiagram className relationshipName -> ShowS
forall className relationshipName.
(Show className, Show relationshipName) =>
[AnyClassDiagram className relationshipName] -> ShowS
forall className relationshipName.
(Show className, Show relationshipName) =>
AnyClassDiagram className relationshipName -> String
$cshowsPrec :: forall className relationshipName.
(Show className, Show relationshipName) =>
Int -> AnyClassDiagram className relationshipName -> ShowS
showsPrec :: Int -> AnyClassDiagram className relationshipName -> ShowS
$cshow :: forall className relationshipName.
(Show className, Show relationshipName) =>
AnyClassDiagram className relationshipName -> String
show :: AnyClassDiagram className relationshipName -> String
$cshowList :: forall className relationshipName.
(Show className, Show relationshipName) =>
[AnyClassDiagram className relationshipName] -> ShowS
showList :: [AnyClassDiagram className relationshipName] -> ShowS
Show)

instance Functor (AnyClassDiagram className) where
  fmap :: forall a b.
(a -> b)
-> AnyClassDiagram className a -> AnyClassDiagram className b
fmap a -> b
f AnyClassDiagram {[className]
[AnyRelationship className a]
anyClassNames :: forall className relationshipName.
AnyClassDiagram className relationshipName -> [className]
anyRelationships :: forall className relationshipName.
AnyClassDiagram className relationshipName
-> [AnyRelationship className relationshipName]
anyClassNames :: [className]
anyRelationships :: [AnyRelationship className a]
..} = AnyClassDiagram {
    anyClassNames :: [className]
anyClassNames = [className]
anyClassNames,
    anyRelationships :: [AnyRelationship className b]
anyRelationships = (AnyRelationship className a -> AnyRelationship className b)
-> [AnyRelationship className a] -> [AnyRelationship className b]
forall a b. (a -> b) -> [a] -> [b]
map ((InvalidRelationship className a
 -> InvalidRelationship className b)
-> (Relationship className a -> Relationship className b)
-> AnyRelationship className a
-> AnyRelationship className b
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
forall a b.
(a -> b)
-> InvalidRelationship className a
-> InvalidRelationship className b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((a -> b) -> Relationship className a -> Relationship className b
forall a b.
(a -> b) -> Relationship className a -> Relationship className b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) [AnyRelationship className a]
anyRelationships
    }

$(deriveBifunctor ''AnyClassDiagram)
$(deriveBifoldable ''AnyClassDiagram)
$(deriveBitraversable ''AnyClassDiagram)

fromClassDiagram
  :: ClassDiagram className relationshipName
  -> AnyClassDiagram className relationshipName
fromClassDiagram :: forall className relationshipName.
ClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName
fromClassDiagram ClassDiagram {[className]
[Relationship className relationshipName]
classNames :: forall className relationshipName.
ClassDiagram className relationshipName -> [className]
relationships :: forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
classNames :: [className]
relationships :: [Relationship className relationshipName]
..} = AnyClassDiagram {
  anyClassNames :: [className]
anyClassNames = [className]
classNames,
  anyRelationships :: [AnyRelationship className relationshipName]
anyRelationships = (Relationship className relationshipName
 -> AnyRelationship className relationshipName)
-> [Relationship className relationshipName]
-> [AnyRelationship className relationshipName]
forall a b. (a -> b) -> [a] -> [b]
map Relationship className relationshipName
-> AnyRelationship className relationshipName
forall a b. b -> Either a b
Right [Relationship className relationshipName]
relationships
  }

type Cd = ClassDiagram String String
type AnyCd = AnyClassDiagram String String
type AnnotatedCd annotation = AnnotatedClassDiagram annotation String String

toValidCd
  :: (
    Eq className,
    MonadThrow m,
    Show className,
    Show relationshipName,
    Typeable className,
    Typeable relationshipName
    )
  => AnyClassDiagram className relationshipName
  -> m (ClassDiagram className relationshipName)
toValidCd :: forall className (m :: * -> *) relationshipName.
(Eq className, MonadThrow m, Show className, Show relationshipName,
 Typeable className, Typeable relationshipName) =>
AnyClassDiagram className relationshipName
-> m (ClassDiagram className relationshipName)
toValidCd AnyClassDiagram {[className]
[AnyRelationship className relationshipName]
anyClassNames :: forall className relationshipName.
AnyClassDiagram className relationshipName -> [className]
anyRelationships :: forall className relationshipName.
AnyClassDiagram className relationshipName
-> [AnyRelationship className relationshipName]
anyClassNames :: [className]
anyRelationships :: [AnyRelationship className relationshipName]
..} = do
  [Relationship className relationshipName]
relationships <- (AnyRelationship className relationshipName
 -> m (Relationship className relationshipName))
-> [AnyRelationship className relationshipName]
-> m [Relationship className relationshipName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnyRelationship className relationshipName
-> m (Relationship className relationshipName)
forall {className} {f :: * -> *} {relationshipName}.
(Eq className, MonadThrow f, Show className, Show relationshipName,
 Typeable className, Typeable relationshipName) =>
Either
  (InvalidRelationship className relationshipName)
  (Relationship className relationshipName)
-> f (Relationship className relationshipName)
toRelationship [AnyRelationship className relationshipName]
anyRelationships
  ClassDiagram className relationshipName
-> m (ClassDiagram className relationshipName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClassDiagram {
    classNames :: [className]
classNames = [className]
anyClassNames,
    [Relationship className relationshipName]
relationships :: [Relationship className relationshipName]
relationships :: [Relationship className relationshipName]
..
    }
  where
    toRelationship :: Either
  (InvalidRelationship className relationshipName)
  (Relationship className relationshipName)
-> f (Relationship className relationshipName)
toRelationship Either
  (InvalidRelationship className relationshipName)
  (Relationship className relationshipName)
anyRelationship
      | Right Relationship className relationshipName
r <- Either
  (InvalidRelationship className relationshipName)
  (Relationship className relationshipName)
anyRelationship
      , Relationship className relationshipName -> Bool
forall className relationshipName.
Eq className =>
Relationship className relationshipName -> Bool
isRelationshipValid Relationship className relationshipName
r = Relationship className relationshipName
-> f (Relationship className relationshipName)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relationship className relationshipName
r
      | Bool
otherwise = WrongRelationshipException className relationshipName
-> f (Relationship className relationshipName)
forall e a. Exception e => e -> f a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (WrongRelationshipException className relationshipName
 -> f (Relationship className relationshipName))
-> WrongRelationshipException className relationshipName
-> f (Relationship className relationshipName)
forall a b. (a -> b) -> a -> b
$ Either
  (InvalidRelationship className relationshipName)
  (Relationship className relationshipName)
-> WrongRelationshipException className relationshipName
forall className relationshipName.
AnyRelationship className relationshipName
-> WrongRelationshipException className relationshipName
UnexpectedInvalidRelationship Either
  (InvalidRelationship className relationshipName)
  (Relationship className relationshipName)
anyRelationship

newtype WrongRelationshipException className relationshipName
  = UnexpectedInvalidRelationship (AnyRelationship className relationshipName)
  deriving Int
-> WrongRelationshipException className relationshipName -> ShowS
[WrongRelationshipException className relationshipName] -> ShowS
WrongRelationshipException className relationshipName -> String
(Int
 -> WrongRelationshipException className relationshipName -> ShowS)
-> (WrongRelationshipException className relationshipName
    -> String)
-> ([WrongRelationshipException className relationshipName]
    -> ShowS)
-> Show (WrongRelationshipException className relationshipName)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall className relationshipName.
(Show className, Show relationshipName) =>
Int
-> WrongRelationshipException className relationshipName -> ShowS
forall className relationshipName.
(Show className, Show relationshipName) =>
[WrongRelationshipException className relationshipName] -> ShowS
forall className relationshipName.
(Show className, Show relationshipName) =>
WrongRelationshipException className relationshipName -> String
$cshowsPrec :: forall className relationshipName.
(Show className, Show relationshipName) =>
Int
-> WrongRelationshipException className relationshipName -> ShowS
showsPrec :: Int
-> WrongRelationshipException className relationshipName -> ShowS
$cshow :: forall className relationshipName.
(Show className, Show relationshipName) =>
WrongRelationshipException className relationshipName -> String
show :: WrongRelationshipException className relationshipName -> String
$cshowList :: forall className relationshipName.
(Show className, Show relationshipName) =>
[WrongRelationshipException className relationshipName] -> ShowS
showList :: [WrongRelationshipException className relationshipName] -> ShowS
Show

instance (
  Show className,
  Show relationshipName,
  Typeable className,
  Typeable relationshipName
  )
  => Exception (WrongRelationshipException className relationshipName)

shuffleAnnotatedClassAndConnectionOrder
  :: MonadRandom m
  => AnnotatedClassDiagram annotation classes relationships
  -> m (AnnotatedClassDiagram annotation classes relationships)
shuffleAnnotatedClassAndConnectionOrder :: forall (m :: * -> *) annotation classes relationships.
MonadRandom m =>
AnnotatedClassDiagram annotation classes relationships
-> m (AnnotatedClassDiagram annotation classes relationships)
shuffleAnnotatedClassAndConnectionOrder AnnotatedClassDiagram {[classes]
[Annotation annotation (AnyRelationship classes relationships)]
annotatedClasses :: forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [className]
annotatedRelationships :: forall relationshipAnnotation className relationshipName.
AnnotatedClassDiagram
  relationshipAnnotation className relationshipName
-> [Annotation
      relationshipAnnotation
      (AnyRelationship className relationshipName)]
annotatedClasses :: [classes]
annotatedRelationships :: [Annotation annotation (AnyRelationship classes relationships)]
..} = [classes]
-> [Annotation annotation (AnyRelationship classes relationships)]
-> AnnotatedClassDiagram annotation classes relationships
forall relationshipAnnotation className relationshipName.
[className]
-> [Annotation
      relationshipAnnotation
      (AnyRelationship className relationshipName)]
-> AnnotatedClassDiagram
     relationshipAnnotation className relationshipName
AnnotatedClassDiagram
  ([classes]
 -> [Annotation annotation (AnyRelationship classes relationships)]
 -> AnnotatedClassDiagram annotation classes relationships)
-> m [classes]
-> m ([Annotation
         annotation (AnyRelationship classes relationships)]
      -> AnnotatedClassDiagram annotation classes relationships)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [classes] -> m [classes]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [classes]
annotatedClasses
  m ([Annotation annotation (AnyRelationship classes relationships)]
   -> AnnotatedClassDiagram annotation classes relationships)
-> m [Annotation
        annotation (AnyRelationship classes relationships)]
-> m (AnnotatedClassDiagram annotation classes relationships)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Annotation annotation (AnyRelationship classes relationships)]
-> m [Annotation
        annotation (AnyRelationship classes relationships)]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Annotation annotation (AnyRelationship classes relationships)]
annotatedRelationships

shuffleAnyClassAndConnectionOrder
  :: MonadRandom m
  => AnyCd
  -> m AnyCd
shuffleAnyClassAndConnectionOrder :: forall (m :: * -> *). MonadRandom m => AnyCd -> m AnyCd
shuffleAnyClassAndConnectionOrder AnyClassDiagram {[String]
[AnyRelationship String String]
anyClassNames :: forall className relationshipName.
AnyClassDiagram className relationshipName -> [className]
anyRelationships :: forall className relationshipName.
AnyClassDiagram className relationshipName
-> [AnyRelationship className relationshipName]
anyClassNames :: [String]
anyRelationships :: [AnyRelationship String String]
..} = [String] -> [AnyRelationship String String] -> AnyCd
forall className relationshipName.
[className]
-> [AnyRelationship className relationshipName]
-> AnyClassDiagram className relationshipName
AnyClassDiagram
  ([String] -> [AnyRelationship String String] -> AnyCd)
-> m [String] -> m ([AnyRelationship String String] -> AnyCd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
anyClassNames
  m ([AnyRelationship String String] -> AnyCd)
-> m [AnyRelationship String String] -> m AnyCd
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [AnyRelationship String String]
-> m [AnyRelationship String String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [AnyRelationship String String]
anyRelationships

shuffleClassAndConnectionOrder :: MonadRandom m => Cd -> m Cd
shuffleClassAndConnectionOrder :: forall (m :: * -> *). MonadRandom m => Cd -> m Cd
shuffleClassAndConnectionOrder ClassDiagram {[String]
[Relationship String String]
classNames :: forall className relationshipName.
ClassDiagram className relationshipName -> [className]
relationships :: forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
classNames :: [String]
relationships :: [Relationship String String]
..} = [String] -> [Relationship String String] -> Cd
forall className relationshipName.
[className]
-> [Relationship className relationshipName]
-> ClassDiagram className relationshipName
ClassDiagram
  ([String] -> [Relationship String String] -> Cd)
-> m [String] -> m ([Relationship String String] -> Cd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
classNames
  m ([Relationship String String] -> Cd)
-> m [Relationship String String] -> m Cd
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Relationship String String] -> m [Relationship String String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Relationship String String]
relationships

data ClassConfig = ClassConfig {
    ClassConfig -> (Int, Int)
classLimits               :: (Int, Int),
    ClassConfig -> (Int, Maybe Int)
aggregationLimits         :: (Int, Maybe Int),
    ClassConfig -> (Int, Maybe Int)
associationLimits         :: (Int, Maybe Int),
    ClassConfig -> (Int, Maybe Int)
compositionLimits         :: (Int, Maybe Int),
    ClassConfig -> (Int, Maybe Int)
inheritanceLimits         :: (Int, Maybe Int),
    -- | the number of relationships including inheritances
    ClassConfig -> (Int, Maybe Int)
relationshipLimits        :: (Int, Maybe Int)
  } deriving (ClassConfig -> ClassConfig -> Bool
(ClassConfig -> ClassConfig -> Bool)
-> (ClassConfig -> ClassConfig -> Bool) -> Eq ClassConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClassConfig -> ClassConfig -> Bool
== :: ClassConfig -> ClassConfig -> Bool
$c/= :: ClassConfig -> ClassConfig -> Bool
/= :: ClassConfig -> ClassConfig -> Bool
Eq, (forall x. ClassConfig -> Rep ClassConfig x)
-> (forall x. Rep ClassConfig x -> ClassConfig)
-> Generic ClassConfig
forall x. Rep ClassConfig x -> ClassConfig
forall x. ClassConfig -> Rep ClassConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClassConfig -> Rep ClassConfig x
from :: forall x. ClassConfig -> Rep ClassConfig x
$cto :: forall x. Rep ClassConfig x -> ClassConfig
to :: forall x. Rep ClassConfig x -> ClassConfig
Generic, ReadPrec [ClassConfig]
ReadPrec ClassConfig
Int -> ReadS ClassConfig
ReadS [ClassConfig]
(Int -> ReadS ClassConfig)
-> ReadS [ClassConfig]
-> ReadPrec ClassConfig
-> ReadPrec [ClassConfig]
-> Read ClassConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ClassConfig
readsPrec :: Int -> ReadS ClassConfig
$creadList :: ReadS [ClassConfig]
readList :: ReadS [ClassConfig]
$creadPrec :: ReadPrec ClassConfig
readPrec :: ReadPrec ClassConfig
$creadListPrec :: ReadPrec [ClassConfig]
readListPrec :: ReadPrec [ClassConfig]
Read, Int -> ClassConfig -> ShowS
[ClassConfig] -> ShowS
ClassConfig -> String
(Int -> ClassConfig -> ShowS)
-> (ClassConfig -> String)
-> ([ClassConfig] -> ShowS)
-> Show ClassConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClassConfig -> ShowS
showsPrec :: Int -> ClassConfig -> ShowS
$cshow :: ClassConfig -> String
show :: ClassConfig -> String
$cshowList :: [ClassConfig] -> ShowS
showList :: [ClassConfig] -> ShowS
Show)

checkClassConfigWithProperties
  :: ClassConfig
  -> RelationshipProperties
  -> Maybe String
checkClassConfigWithProperties :: ClassConfig -> RelationshipProperties -> Maybe String
checkClassConfigWithProperties
  c :: ClassConfig
c@ClassConfig {(Int, Int)
(Int, Maybe Int)
classLimits :: ClassConfig -> (Int, Int)
aggregationLimits :: ClassConfig -> (Int, Maybe Int)
associationLimits :: ClassConfig -> (Int, Maybe Int)
compositionLimits :: ClassConfig -> (Int, Maybe Int)
inheritanceLimits :: ClassConfig -> (Int, Maybe Int)
relationshipLimits :: ClassConfig -> (Int, Maybe Int)
classLimits :: (Int, Int)
aggregationLimits :: (Int, Maybe Int)
associationLimits :: (Int, Maybe Int)
compositionLimits :: (Int, Maybe Int)
inheritanceLimits :: (Int, Maybe Int)
relationshipLimits :: (Int, Maybe Int)
..}
  RelationshipProperties {Bool
Int
Maybe Bool
invalidInheritances :: Int
wrongNonInheritances :: Int
wrongCompositions :: Int
selfRelationshipsAmount :: Int
selfInheritancesAmount :: Int
hasDoubleRelationships :: Maybe Bool
hasReverseRelationships :: Maybe Bool
hasReverseInheritances :: Bool
hasMultipleInheritances :: Maybe Bool
hasNonTrivialInheritanceCycles :: Bool
hasCompositionCycles :: Bool
hasCompositionsPreventingParts :: Maybe Bool
hasThickEdges :: Maybe Bool
invalidInheritances :: RelationshipProperties -> Int
wrongNonInheritances :: RelationshipProperties -> Int
wrongCompositions :: RelationshipProperties -> Int
selfRelationshipsAmount :: RelationshipProperties -> Int
selfInheritancesAmount :: RelationshipProperties -> Int
hasDoubleRelationships :: RelationshipProperties -> Maybe Bool
hasReverseRelationships :: RelationshipProperties -> Maybe Bool
hasReverseInheritances :: RelationshipProperties -> Bool
hasMultipleInheritances :: RelationshipProperties -> Maybe Bool
hasNonTrivialInheritanceCycles :: RelationshipProperties -> Bool
hasCompositionCycles :: RelationshipProperties -> Bool
hasCompositionsPreventingParts :: RelationshipProperties -> Maybe Bool
hasThickEdges :: RelationshipProperties -> Maybe Bool
..}
  | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Bool
hasDoubleRelationships
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    'hasDoubleRelationships' must not be set to 'Nothing'
    |]
  | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Bool
hasReverseRelationships
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    'hasReverseRelationships' must not be set to 'Nothing'
    |]
  | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Bool
hasMultipleInheritances
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    'hasMultipleInheritances' must not be set to 'Nothing'
    |]
  | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Bool
hasCompositionsPreventingParts
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    'hasCompositionsPreventingParts' must not be set to 'Nothing'
    |]
  | Int
wrongNonInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxRelations Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
inheritanceLimits
  Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
wrongNonInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) Maybe Int
maxNonInheritances'
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The (maximum) number of non-inheritance relationships is too low for
    the aimed at wrongNonInheritances!
    |]
  | Int
wrongCompositions Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCompositions
  Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
wrongCompositions Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) ((Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
compositionLimits)
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The (maximum) number of possible compositions is too low for
    the aimed at wrongCompositions!
    |]
  | Int
minCompositions Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCompositions
  Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
minCompositions Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) ((Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
compositionLimits)
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The (maximum) number of possible compositions is too low for
    the aimed at composition properties!
    |]
  | Int
minCompositionsInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCompositionsInheritances
  Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
minCompositionsInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) Maybe Int
maxCompositionsInheritances'
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The (maximum) number of possible compositions or inheritances is too low for
    creating composition cycles!
    |]
  | Int
minNonInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxRelations Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
inheritanceLimits
  Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
minNonInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) Maybe Int
maxNonInheritances'
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The (maximum) number of possible non-inheritance relationships is too low for
    the aimed at non-inheritance relationship properties!
    |]
  | Int
minInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxInheritances
  Bool -> Bool -> Bool
|| Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
minInheritances Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) ((Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
inheritanceLimits)
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The (maximum) number of possible inheritance relationships is too low for
    the aimed at inheritance relationship properties!
    |]
  | Just Int
x <- (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
relationshipLimits,
    Just Int
relationships <- ClassConfig -> Maybe Int
relationshipsSum ClassConfig
c,
    Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
relationships
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The maximum number of relationships is too high
    according to individual relationship maxima!
    |]
  | x :: Maybe Int
x@Just {} <- (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
relationshipLimits
  , ((Int, Maybe Int) -> Bool) -> [(Int, Maybe Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
> Maybe Int
x) (Maybe Int -> Bool)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) [
      (Int, Maybe Int)
aggregationLimits,
      (Int, Maybe Int)
associationLimits,
      (Int, Maybe Int)
compositionLimits,
      (Int, Maybe Int)
inheritanceLimits
      ]
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The maximum number of aggregations, associations, compositions
    as well as inheritances
    must not be higher than the maximum number of relationships!
    |]
  | Bool
otherwise = ClassConfig -> Maybe String
checkClassConfig ClassConfig
c
  where
    for :: p -> Bool -> p
for p
x Bool
y = if Bool
y then p
x else p
0
    forMaybe :: a -> Maybe Bool -> a
forMaybe a
x Maybe Bool
y
      | Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
y = a
0
      | Bool
otherwise = a
x
    plusOne :: a -> a
plusOne a
x = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 then a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 else a
x
    minNonInheritances :: Int
minNonInheritances = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
selfRelationshipsAmount) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall {a}. (Eq a, Num a) => a -> a
plusOne (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [
      Int
1 Int -> Maybe Bool -> Int
forall {a}. Num a => a -> Maybe Bool -> a
`forMaybe` Maybe Bool
hasDoubleRelationships,
      Int
1 Int -> Maybe Bool -> Int
forall {a}. Num a => a -> Maybe Bool -> a
`forMaybe` Maybe Bool
hasReverseRelationships
      ]
    minInheritances :: Int
minInheritances = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
selfInheritancesAmount) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall {a}. (Eq a, Num a) => a -> a
plusOne (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [
      Int
1 Int -> Bool -> Int
forall {p}. Num p => p -> Bool -> p
`for` Bool
hasReverseInheritances,
      Int
1 Int -> Maybe Bool -> Int
forall {a}. Num a => a -> Maybe Bool -> a
`forMaybe` Maybe Bool
hasMultipleInheritances,
      Int
2 Int -> Bool -> Int
forall {p}. Num p => p -> Bool -> p
`for` Bool
hasNonTrivialInheritanceCycles
      ]
    minCompositions :: Int
minCompositions = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max
      (Int
1 Int -> Bool -> Int
forall {p}. Num p => p -> Bool -> p
`for` Bool
hasCompositionCycles)
      (Int
2 Int -> Maybe Bool -> Int
forall {a}. Num a => a -> Maybe Bool -> a
`forMaybe` Maybe Bool
hasCompositionsPreventingParts)
    minCompositionsInheritances :: Int
minCompositionsInheritances =
      Int
3 Int -> Bool -> Int
forall {p}. Num p => p -> Bool -> p
`for` Bool
hasCompositionCycles
    maxRelations :: Int
maxRelations = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (ClassConfig -> Int
maxRelationships ClassConfig
c) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
relationshipLimits
    maxCompositionsInheritances :: Int
maxCompositionsInheritances = Int
maxRelations
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
aggregationLimits
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
associationLimits
    maxCompositions :: Int
maxCompositions = Int
maxCompositionsInheritances Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
inheritanceLimits
    maxInheritances :: Int
maxInheritances = Int
maxCompositionsInheritances Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
compositionLimits
    maxCompositionsInheritances' :: Maybe Int
maxCompositionsInheritances' = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
      (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
compositionLimits
      Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
inheritanceLimits
    maxNonInheritances' :: Maybe Int
maxNonInheritances' = (\Int
x Int
y Int
z -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z)
      (Int -> Int -> Int -> Int)
-> Maybe Int -> Maybe (Int -> Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
aggregationLimits
      Maybe (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
associationLimits
      Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
compositionLimits

checkClassConfig :: ClassConfig -> Maybe String
checkClassConfig :: ClassConfig -> Maybe String
checkClassConfig c :: ClassConfig
c@ClassConfig {(Int, Int)
(Int, Maybe Int)
classLimits :: ClassConfig -> (Int, Int)
aggregationLimits :: ClassConfig -> (Int, Maybe Int)
associationLimits :: ClassConfig -> (Int, Maybe Int)
compositionLimits :: ClassConfig -> (Int, Maybe Int)
inheritanceLimits :: ClassConfig -> (Int, Maybe Int)
relationshipLimits :: ClassConfig -> (Int, Maybe Int)
classLimits :: (Int, Int)
aggregationLimits :: (Int, Maybe Int)
associationLimits :: (Int, Maybe Int)
compositionLimits :: (Int, Maybe Int)
inheritanceLimits :: (Int, Maybe Int)
relationshipLimits :: (Int, Maybe Int)
..}
  | (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
classLimits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    Having possibly no classes does not make any sense for this task type.
    |]
  | Int
minimumMaxRelationships Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
relationshipLimits
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The minimal number of classes does not even suffice for
    the minimal number of relationships.
    |]
  | Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maximumMaxRelationships Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
relationshipLimits
    Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing ((Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
relationshipLimits)
    Bool -> Bool -> Bool
&& Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maximumMaxRelationships Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
< ClassConfig -> Maybe Int
relationshipsSum ClassConfig
c
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The maximal number of classes is too low considering
    the upper relationship bounds.
    |]
  | Bool
otherwise = (Int -> Maybe Int) -> String -> (Int, Int) -> Maybe String
forall n b.
(Num n, Ord n, Show b, Show n) =>
(b -> Maybe n) -> String -> (n, b) -> Maybe String
checkRange Int -> Maybe Int
forall a. a -> Maybe a
Just String
"classLimits" (Int, Int)
classLimits
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Int -> Maybe Int)
-> String -> (Int, Maybe Int) -> Maybe String
forall n b.
(Num n, Ord n, Show b, Show n) =>
(b -> Maybe n) -> String -> (n, b) -> Maybe String
checkRange Maybe Int -> Maybe Int
forall a. a -> a
id String
"aggregationLimits" (Int, Maybe Int)
aggregationLimits
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Int -> Maybe Int)
-> String -> (Int, Maybe Int) -> Maybe String
forall n b.
(Num n, Ord n, Show b, Show n) =>
(b -> Maybe n) -> String -> (n, b) -> Maybe String
checkRange Maybe Int -> Maybe Int
forall a. a -> a
id String
"associationLimits" (Int, Maybe Int)
associationLimits
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Int -> Maybe Int)
-> String -> (Int, Maybe Int) -> Maybe String
forall n b.
(Num n, Ord n, Show b, Show n) =>
(b -> Maybe n) -> String -> (n, b) -> Maybe String
checkRange Maybe Int -> Maybe Int
forall a. a -> a
id String
"compositionLimits" (Int, Maybe Int)
compositionLimits
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Int -> Maybe Int)
-> String -> (Int, Maybe Int) -> Maybe String
forall n b.
(Num n, Ord n, Show b, Show n) =>
(b -> Maybe n) -> String -> (n, b) -> Maybe String
checkRange Maybe Int -> Maybe Int
forall a. a -> a
id String
"inheritanceLimits" (Int, Maybe Int)
inheritanceLimits
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Int -> Maybe Int)
-> String -> (Int, Maybe Int) -> Maybe String
forall n b.
(Num n, Ord n, Show b, Show n) =>
(b -> Maybe n) -> String -> (n, b) -> Maybe String
checkRange Maybe Int -> Maybe Int
forall a. a -> a
id String
"relationshipLimits" (Int, Maybe Int)
relationshipLimits
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> String -> Maybe String
forall {a}. Bool -> a -> Maybe a
toMaybe ((Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
relationshipLimits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ClassConfig -> Int
minRelationships ClassConfig
c) [iii|
      The sum of the minimum number of aggregations, associations, compositions
      and inheritances
      must not be higher than the minimum number of relationships!
      |]
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
    Maybe Int -> Maybe ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe Int -> Maybe ()) -> Maybe Int -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
relationshipLimits
    Bool -> String -> Maybe String
forall {a}. Bool -> a -> Maybe a
toMaybe Bool
isMaxHigherThanAnyIndividual [iii|
      The maximum number of aggregations, associations, compositions
      as well as inheritances
      must not be higher than the maximum number of relationships!
      |]
  where
    minimumMaxRelationships :: Int
minimumMaxRelationships = (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
classLimits Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
classLimits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    maximumMaxRelationships :: Int
maximumMaxRelationships = (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
classLimits Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
classLimits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    toMaybe :: Bool -> a -> Maybe a
toMaybe Bool
True a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    toMaybe Bool
_    a
_ = Maybe a
forall a. Maybe a
Nothing
    isMaxHigherThanAnyIndividual :: Bool
isMaxHigherThanAnyIndividual = ((Int, Maybe Int) -> Bool) -> [(Int, Maybe Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
      ((Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
relationshipLimits) (Maybe Int -> Bool)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) [
        (Int, Maybe Int)
aggregationLimits,
        (Int, Maybe Int)
associationLimits,
        (Int, Maybe Int)
compositionLimits,
        (Int, Maybe Int)
inheritanceLimits
        ]

{-|
Additional structural constraints that should be applied to all class diagrams.
-}
newtype CdConstraints
  = CdConstraints {
    CdConstraints -> Maybe Bool
anyCompositionCyclesInvolveInheritances :: Maybe Bool
    -- ^ if composition cycles have to contain inheritances (@Just True@),
    -- must not contain inheritances (@Just False@),
    -- or could contain inheritances (@Nothing@)
    } deriving (CdConstraints -> CdConstraints -> Bool
(CdConstraints -> CdConstraints -> Bool)
-> (CdConstraints -> CdConstraints -> Bool) -> Eq CdConstraints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CdConstraints -> CdConstraints -> Bool
== :: CdConstraints -> CdConstraints -> Bool
$c/= :: CdConstraints -> CdConstraints -> Bool
/= :: CdConstraints -> CdConstraints -> Bool
Eq, (forall x. CdConstraints -> Rep CdConstraints x)
-> (forall x. Rep CdConstraints x -> CdConstraints)
-> Generic CdConstraints
forall x. Rep CdConstraints x -> CdConstraints
forall x. CdConstraints -> Rep CdConstraints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CdConstraints -> Rep CdConstraints x
from :: forall x. CdConstraints -> Rep CdConstraints x
$cto :: forall x. Rep CdConstraints x -> CdConstraints
to :: forall x. Rep CdConstraints x -> CdConstraints
Generic, ReadPrec [CdConstraints]
ReadPrec CdConstraints
Int -> ReadS CdConstraints
ReadS [CdConstraints]
(Int -> ReadS CdConstraints)
-> ReadS [CdConstraints]
-> ReadPrec CdConstraints
-> ReadPrec [CdConstraints]
-> Read CdConstraints
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CdConstraints
readsPrec :: Int -> ReadS CdConstraints
$creadList :: ReadS [CdConstraints]
readList :: ReadS [CdConstraints]
$creadPrec :: ReadPrec CdConstraints
readPrec :: ReadPrec CdConstraints
$creadListPrec :: ReadPrec [CdConstraints]
readListPrec :: ReadPrec [CdConstraints]
Read, Int -> CdConstraints -> ShowS
[CdConstraints] -> ShowS
CdConstraints -> String
(Int -> CdConstraints -> ShowS)
-> (CdConstraints -> String)
-> ([CdConstraints] -> ShowS)
-> Show CdConstraints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CdConstraints -> ShowS
showsPrec :: Int -> CdConstraints -> ShowS
$cshow :: CdConstraints -> String
show :: CdConstraints -> String
$cshowList :: [CdConstraints] -> ShowS
showList :: [CdConstraints] -> ShowS
Show)

defaultCdConstraints :: CdConstraints
defaultCdConstraints :: CdConstraints
defaultCdConstraints = CdConstraints {
  anyCompositionCyclesInvolveInheritances :: Maybe Bool
anyCompositionCyclesInvolveInheritances = Maybe Bool
forall a. Maybe a
Nothing
  }

checkCdConstraints :: AllowedProperties -> CdConstraints -> Maybe String
checkCdConstraints :: AllowedProperties -> CdConstraints -> Maybe String
checkCdConstraints AllowedProperties {Bool
compositionCycles :: Bool
doubleRelationships :: Bool
inheritanceCycles :: Bool
invalidInheritanceLimits :: Bool
reverseInheritances :: Bool
reverseRelationships :: Bool
selfInheritances :: Bool
selfRelationships :: Bool
wrongAssociationLimits :: Bool
wrongCompositionLimits :: Bool
compositionCycles :: AllowedProperties -> Bool
doubleRelationships :: AllowedProperties -> Bool
inheritanceCycles :: AllowedProperties -> Bool
invalidInheritanceLimits :: AllowedProperties -> Bool
reverseInheritances :: AllowedProperties -> Bool
reverseRelationships :: AllowedProperties -> Bool
selfInheritances :: AllowedProperties -> Bool
selfRelationships :: AllowedProperties -> Bool
wrongAssociationLimits :: AllowedProperties -> Bool
wrongCompositionLimits :: AllowedProperties -> Bool
..} CdConstraints {Maybe Bool
anyCompositionCyclesInvolveInheritances :: CdConstraints -> Maybe Bool
anyCompositionCyclesInvolveInheritances :: Maybe Bool
..}
  | Bool -> Bool
not Bool
compositionCycles, Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
anyCompositionCyclesInvolveInheritances
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    Setting anyCompositionCyclesInvolveInheritances to True or False
    makes no sense when composition cycles are not allowed.
    |]
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing

checkRange
  :: (Num n, Ord n, Show b, Show n)
  => (b -> Maybe n)
  -> String
  -> (n, b)
  -> Maybe String
checkRange :: forall n b.
(Num n, Ord n, Show b, Show n) =>
(b -> Maybe n) -> String -> (n, b) -> Maybe String
checkRange b -> Maybe n
g String
what (n
low, b
h) = do
  n
high <- b -> Maybe n
g b
h
  n -> Maybe String
assert n
high
  where
    assert :: n -> Maybe String
assert n
high
      | n
low n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 = forall a. a -> Maybe a
Just @String [iii|
        The lower limit for #{what} has to be at least 0!
        |]
      | n
high n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
low = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
        The upper limit (currently #{show h}; second value) for #{what}
        has to be at least as high as its lower limit
        (currently #{show low}; first value)!
        |]
      | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing

checkObjectDiagram
  :: Ord objectName
  => ObjectDiagram objectName className linkLabel
  -> Maybe String
checkObjectDiagram :: forall objectName className linkLabel.
Ord objectName =>
ObjectDiagram objectName className linkLabel -> Maybe String
checkObjectDiagram ObjectDiagram {[Link objectName linkLabel]
[Object objectName className]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object objectName className]
links :: [Link objectName linkLabel]
..}
  | [objectName]
objectNames [objectName] -> [objectName] -> Bool
forall a. Eq a => a -> a -> Bool
/= [objectName] -> [objectName]
forall a. Ord a => [a] -> [a]
nubOrd [objectName]
objectNames
  = String -> Maybe String
forall a. a -> Maybe a
Just String
"Every objectName has to be unique across the whole object diagram!"
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing
  where
    objectNames :: [objectName]
objectNames = (Object objectName className -> objectName)
-> [Object objectName className] -> [objectName]
forall a b. (a -> b) -> [a] -> [b]
map Object objectName className -> objectName
forall objectName className.
Object objectName className -> objectName
objectName [Object objectName className]
objects

minRelationships :: ClassConfig -> Int
minRelationships :: ClassConfig -> Int
minRelationships ClassConfig {(Int, Int)
(Int, Maybe Int)
classLimits :: ClassConfig -> (Int, Int)
aggregationLimits :: ClassConfig -> (Int, Maybe Int)
associationLimits :: ClassConfig -> (Int, Maybe Int)
compositionLimits :: ClassConfig -> (Int, Maybe Int)
inheritanceLimits :: ClassConfig -> (Int, Maybe Int)
relationshipLimits :: ClassConfig -> (Int, Maybe Int)
classLimits :: (Int, Int)
aggregationLimits :: (Int, Maybe Int)
associationLimits :: (Int, Maybe Int)
compositionLimits :: (Int, Maybe Int)
inheritanceLimits :: (Int, Maybe Int)
relationshipLimits :: (Int, Maybe Int)
..} =
  (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
aggregationLimits
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
associationLimits
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
compositionLimits
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
inheritanceLimits

relationshipsSum :: ClassConfig -> Maybe Int
relationshipsSum :: ClassConfig -> Maybe Int
relationshipsSum ClassConfig {(Int, Int)
(Int, Maybe Int)
classLimits :: ClassConfig -> (Int, Int)
aggregationLimits :: ClassConfig -> (Int, Maybe Int)
associationLimits :: ClassConfig -> (Int, Maybe Int)
compositionLimits :: ClassConfig -> (Int, Maybe Int)
inheritanceLimits :: ClassConfig -> (Int, Maybe Int)
relationshipLimits :: ClassConfig -> (Int, Maybe Int)
classLimits :: (Int, Int)
aggregationLimits :: (Int, Maybe Int)
associationLimits :: (Int, Maybe Int)
compositionLimits :: (Int, Maybe Int)
inheritanceLimits :: (Int, Maybe Int)
relationshipLimits :: (Int, Maybe Int)
..} = Int -> Int -> Int -> Int -> Int
forall {a}. Num a => a -> a -> a -> a -> a
sumOf4
  (Int -> Int -> Int -> Int -> Int)
-> Maybe Int -> Maybe (Int -> Int -> Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
aggregationLimits
  Maybe (Int -> Int -> Int -> Int)
-> Maybe Int -> Maybe (Int -> Int -> Int)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
associationLimits
  Maybe (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
compositionLimits
  Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Int, Maybe Int)
inheritanceLimits
  where
    sumOf4 :: a -> a -> a -> a -> a
sumOf4 a
w a
x a
y a
z = a
w a -> a -> a
forall a. Num a => a -> a -> a
+ a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
z

maxRelationships :: ClassConfig -> Int
maxRelationships :: ClassConfig -> Int
maxRelationships ClassConfig
config = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
maxClasses Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
maxClasses Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
  (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ClassConfig -> Maybe Int
relationshipsSum ClassConfig
config
  where
    maxClasses :: Int
maxClasses = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ ClassConfig -> (Int, Int)
classLimits ClassConfig
config

{-|
These parameters influence the appearance of the class diagram when drawn.
-}
data CdDrawSettings
  = CdDrawSettings {
    -- | These defaults will be omitted
    CdDrawSettings -> OmittedDefaultMultiplicities
omittedDefaults :: !OmittedDefaultMultiplicities,
    -- | When set to 'False' relationship names will be omitted
    CdDrawSettings -> Bool
printNames :: !Bool,
    -- | When set to 'False' association arrows will be omitted
    CdDrawSettings -> Bool
printNavigations :: !Bool
    }
  deriving (Typeable CdDrawSettings
Typeable CdDrawSettings
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CdDrawSettings -> c CdDrawSettings)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CdDrawSettings)
-> (CdDrawSettings -> Constr)
-> (CdDrawSettings -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CdDrawSettings))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CdDrawSettings))
-> ((forall b. Data b => b -> b)
    -> CdDrawSettings -> CdDrawSettings)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CdDrawSettings -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CdDrawSettings -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CdDrawSettings -> m CdDrawSettings)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CdDrawSettings -> m CdDrawSettings)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CdDrawSettings -> m CdDrawSettings)
-> Data CdDrawSettings
CdDrawSettings -> Constr
CdDrawSettings -> DataType
(forall b. Data b => b -> b) -> CdDrawSettings -> CdDrawSettings
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CdDrawSettings -> u
forall u. (forall d. Data d => d -> u) -> CdDrawSettings -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CdDrawSettings
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CdDrawSettings -> c CdDrawSettings
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CdDrawSettings)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CdDrawSettings)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CdDrawSettings -> c CdDrawSettings
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CdDrawSettings -> c CdDrawSettings
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CdDrawSettings
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CdDrawSettings
$ctoConstr :: CdDrawSettings -> Constr
toConstr :: CdDrawSettings -> Constr
$cdataTypeOf :: CdDrawSettings -> DataType
dataTypeOf :: CdDrawSettings -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CdDrawSettings)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CdDrawSettings)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CdDrawSettings)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CdDrawSettings)
$cgmapT :: (forall b. Data b => b -> b) -> CdDrawSettings -> CdDrawSettings
gmapT :: (forall b. Data b => b -> b) -> CdDrawSettings -> CdDrawSettings
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CdDrawSettings -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CdDrawSettings -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CdDrawSettings -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CdDrawSettings -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CdDrawSettings -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CdDrawSettings -> m CdDrawSettings
Data, CdDrawSettings -> CdDrawSettings -> Bool
(CdDrawSettings -> CdDrawSettings -> Bool)
-> (CdDrawSettings -> CdDrawSettings -> Bool) -> Eq CdDrawSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CdDrawSettings -> CdDrawSettings -> Bool
== :: CdDrawSettings -> CdDrawSettings -> Bool
$c/= :: CdDrawSettings -> CdDrawSettings -> Bool
/= :: CdDrawSettings -> CdDrawSettings -> Bool
Eq, (forall x. CdDrawSettings -> Rep CdDrawSettings x)
-> (forall x. Rep CdDrawSettings x -> CdDrawSettings)
-> Generic CdDrawSettings
forall x. Rep CdDrawSettings x -> CdDrawSettings
forall x. CdDrawSettings -> Rep CdDrawSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CdDrawSettings -> Rep CdDrawSettings x
from :: forall x. CdDrawSettings -> Rep CdDrawSettings x
$cto :: forall x. Rep CdDrawSettings x -> CdDrawSettings
to :: forall x. Rep CdDrawSettings x -> CdDrawSettings
Generic, ReadPrec [CdDrawSettings]
ReadPrec CdDrawSettings
Int -> ReadS CdDrawSettings
ReadS [CdDrawSettings]
(Int -> ReadS CdDrawSettings)
-> ReadS [CdDrawSettings]
-> ReadPrec CdDrawSettings
-> ReadPrec [CdDrawSettings]
-> Read CdDrawSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CdDrawSettings
readsPrec :: Int -> ReadS CdDrawSettings
$creadList :: ReadS [CdDrawSettings]
readList :: ReadS [CdDrawSettings]
$creadPrec :: ReadPrec CdDrawSettings
readPrec :: ReadPrec CdDrawSettings
$creadListPrec :: ReadPrec [CdDrawSettings]
readListPrec :: ReadPrec [CdDrawSettings]
Read, Int -> CdDrawSettings -> ShowS
[CdDrawSettings] -> ShowS
CdDrawSettings -> String
(Int -> CdDrawSettings -> ShowS)
-> (CdDrawSettings -> String)
-> ([CdDrawSettings] -> ShowS)
-> Show CdDrawSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CdDrawSettings -> ShowS
showsPrec :: Int -> CdDrawSettings -> ShowS
$cshow :: CdDrawSettings -> String
show :: CdDrawSettings -> String
$cshowList :: [CdDrawSettings] -> ShowS
showList :: [CdDrawSettings] -> ShowS
Show)

defaultCdDrawSettings :: CdDrawSettings
defaultCdDrawSettings :: CdDrawSettings
defaultCdDrawSettings = CdDrawSettings {
  omittedDefaults :: OmittedDefaultMultiplicities
omittedDefaults = OmittedDefaultMultiplicities
defaultOmittedDefaultMultiplicities,
  printNames :: Bool
printNames = Bool
True,
  printNavigations :: Bool
printNavigations = Bool
True
  }

checkCdDrawSettings :: CdDrawSettings -> Maybe String
checkCdDrawSettings :: CdDrawSettings -> Maybe String
checkCdDrawSettings CdDrawSettings {Bool
OmittedDefaultMultiplicities
omittedDefaults :: CdDrawSettings -> OmittedDefaultMultiplicities
printNames :: CdDrawSettings -> Bool
printNavigations :: CdDrawSettings -> Bool
omittedDefaults :: OmittedDefaultMultiplicities
printNames :: Bool
printNavigations :: Bool
..} =
  OmittedDefaultMultiplicities -> Maybe String
checkOmittedDefaultMultiplicities OmittedDefaultMultiplicities
omittedDefaults

{-|
Checks compatibility of draw settings with allowed properties
preventing situations that could be misinterpreted.
-}
checkCdDrawProperties :: CdDrawSettings -> AllowedProperties -> Maybe String
checkCdDrawProperties :: CdDrawSettings -> AllowedProperties -> Maybe String
checkCdDrawProperties CdDrawSettings {Bool
OmittedDefaultMultiplicities
omittedDefaults :: CdDrawSettings -> OmittedDefaultMultiplicities
printNames :: CdDrawSettings -> Bool
printNavigations :: CdDrawSettings -> Bool
omittedDefaults :: OmittedDefaultMultiplicities
printNames :: Bool
printNavigations :: Bool
..} AllowedProperties {Bool
compositionCycles :: AllowedProperties -> Bool
doubleRelationships :: AllowedProperties -> Bool
inheritanceCycles :: AllowedProperties -> Bool
invalidInheritanceLimits :: AllowedProperties -> Bool
reverseInheritances :: AllowedProperties -> Bool
reverseRelationships :: AllowedProperties -> Bool
selfInheritances :: AllowedProperties -> Bool
selfRelationships :: AllowedProperties -> Bool
wrongAssociationLimits :: AllowedProperties -> Bool
wrongCompositionLimits :: AllowedProperties -> Bool
compositionCycles :: Bool
doubleRelationships :: Bool
inheritanceCycles :: Bool
invalidInheritanceLimits :: Bool
reverseInheritances :: Bool
reverseRelationships :: Bool
selfInheritances :: Bool
selfRelationships :: Bool
wrongAssociationLimits :: Bool
wrongCompositionLimits :: Bool
..}
  | Bool
doubleRelationships Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
printNames
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    'doubleRelationships' can only be enabled,
    if relationship names are printed.
    Otherwise this constellation might be determined as illegal
    (as they could have the same name).
    |]
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing

{-|
Defines default multiplicities which should be omitted
when drawing the class diagram.
-}
data OmittedDefaultMultiplicities
  = OmittedDefaultMultiplicities {
    OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity :: !(Maybe (Int, Maybe Int)),
    OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity :: !(Maybe (Int, Maybe Int)),
    OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity :: !(Maybe (Int, Maybe Int))
    }
  deriving (Typeable OmittedDefaultMultiplicities
Typeable OmittedDefaultMultiplicities
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> OmittedDefaultMultiplicities
    -> c OmittedDefaultMultiplicities)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c OmittedDefaultMultiplicities)
-> (OmittedDefaultMultiplicities -> Constr)
-> (OmittedDefaultMultiplicities -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c OmittedDefaultMultiplicities))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OmittedDefaultMultiplicities))
-> ((forall b. Data b => b -> b)
    -> OmittedDefaultMultiplicities -> OmittedDefaultMultiplicities)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> OmittedDefaultMultiplicities
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> OmittedDefaultMultiplicities
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> OmittedDefaultMultiplicities -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> OmittedDefaultMultiplicities
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities)
-> Data OmittedDefaultMultiplicities
OmittedDefaultMultiplicities -> Constr
OmittedDefaultMultiplicities -> DataType
(forall b. Data b => b -> b)
-> OmittedDefaultMultiplicities -> OmittedDefaultMultiplicities
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> OmittedDefaultMultiplicities
-> u
forall u.
(forall d. Data d => d -> u) -> OmittedDefaultMultiplicities -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> OmittedDefaultMultiplicities
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> OmittedDefaultMultiplicities
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OmittedDefaultMultiplicities
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> OmittedDefaultMultiplicities
-> c OmittedDefaultMultiplicities
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c OmittedDefaultMultiplicities)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OmittedDefaultMultiplicities)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> OmittedDefaultMultiplicities
-> c OmittedDefaultMultiplicities
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> OmittedDefaultMultiplicities
-> c OmittedDefaultMultiplicities
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OmittedDefaultMultiplicities
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OmittedDefaultMultiplicities
$ctoConstr :: OmittedDefaultMultiplicities -> Constr
toConstr :: OmittedDefaultMultiplicities -> Constr
$cdataTypeOf :: OmittedDefaultMultiplicities -> DataType
dataTypeOf :: OmittedDefaultMultiplicities -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c OmittedDefaultMultiplicities)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c OmittedDefaultMultiplicities)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OmittedDefaultMultiplicities)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OmittedDefaultMultiplicities)
$cgmapT :: (forall b. Data b => b -> b)
-> OmittedDefaultMultiplicities -> OmittedDefaultMultiplicities
gmapT :: (forall b. Data b => b -> b)
-> OmittedDefaultMultiplicities -> OmittedDefaultMultiplicities
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> OmittedDefaultMultiplicities
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> OmittedDefaultMultiplicities
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> OmittedDefaultMultiplicities
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> OmittedDefaultMultiplicities
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> OmittedDefaultMultiplicities -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> OmittedDefaultMultiplicities -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> OmittedDefaultMultiplicities
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> OmittedDefaultMultiplicities
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OmittedDefaultMultiplicities -> m OmittedDefaultMultiplicities
Data, OmittedDefaultMultiplicities
-> OmittedDefaultMultiplicities -> Bool
(OmittedDefaultMultiplicities
 -> OmittedDefaultMultiplicities -> Bool)
-> (OmittedDefaultMultiplicities
    -> OmittedDefaultMultiplicities -> Bool)
-> Eq OmittedDefaultMultiplicities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OmittedDefaultMultiplicities
-> OmittedDefaultMultiplicities -> Bool
== :: OmittedDefaultMultiplicities
-> OmittedDefaultMultiplicities -> Bool
$c/= :: OmittedDefaultMultiplicities
-> OmittedDefaultMultiplicities -> Bool
/= :: OmittedDefaultMultiplicities
-> OmittedDefaultMultiplicities -> Bool
Eq, (forall x.
 OmittedDefaultMultiplicities -> Rep OmittedDefaultMultiplicities x)
-> (forall x.
    Rep OmittedDefaultMultiplicities x -> OmittedDefaultMultiplicities)
-> Generic OmittedDefaultMultiplicities
forall x.
Rep OmittedDefaultMultiplicities x -> OmittedDefaultMultiplicities
forall x.
OmittedDefaultMultiplicities -> Rep OmittedDefaultMultiplicities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OmittedDefaultMultiplicities -> Rep OmittedDefaultMultiplicities x
from :: forall x.
OmittedDefaultMultiplicities -> Rep OmittedDefaultMultiplicities x
$cto :: forall x.
Rep OmittedDefaultMultiplicities x -> OmittedDefaultMultiplicities
to :: forall x.
Rep OmittedDefaultMultiplicities x -> OmittedDefaultMultiplicities
Generic, ReadPrec [OmittedDefaultMultiplicities]
ReadPrec OmittedDefaultMultiplicities
Int -> ReadS OmittedDefaultMultiplicities
ReadS [OmittedDefaultMultiplicities]
(Int -> ReadS OmittedDefaultMultiplicities)
-> ReadS [OmittedDefaultMultiplicities]
-> ReadPrec OmittedDefaultMultiplicities
-> ReadPrec [OmittedDefaultMultiplicities]
-> Read OmittedDefaultMultiplicities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OmittedDefaultMultiplicities
readsPrec :: Int -> ReadS OmittedDefaultMultiplicities
$creadList :: ReadS [OmittedDefaultMultiplicities]
readList :: ReadS [OmittedDefaultMultiplicities]
$creadPrec :: ReadPrec OmittedDefaultMultiplicities
readPrec :: ReadPrec OmittedDefaultMultiplicities
$creadListPrec :: ReadPrec [OmittedDefaultMultiplicities]
readListPrec :: ReadPrec [OmittedDefaultMultiplicities]
Read, Int -> OmittedDefaultMultiplicities -> ShowS
[OmittedDefaultMultiplicities] -> ShowS
OmittedDefaultMultiplicities -> String
(Int -> OmittedDefaultMultiplicities -> ShowS)
-> (OmittedDefaultMultiplicities -> String)
-> ([OmittedDefaultMultiplicities] -> ShowS)
-> Show OmittedDefaultMultiplicities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OmittedDefaultMultiplicities -> ShowS
showsPrec :: Int -> OmittedDefaultMultiplicities -> ShowS
$cshow :: OmittedDefaultMultiplicities -> String
show :: OmittedDefaultMultiplicities -> String
$cshowList :: [OmittedDefaultMultiplicities] -> ShowS
showList :: [OmittedDefaultMultiplicities] -> ShowS
Show)

defaultOmittedDefaultMultiplicities :: OmittedDefaultMultiplicities
defaultOmittedDefaultMultiplicities :: OmittedDefaultMultiplicities
defaultOmittedDefaultMultiplicities = OmittedDefaultMultiplicities {
  aggregationWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
0, Maybe Int
forall a. Maybe a
Nothing),
  associationOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
0, Maybe Int
forall a. Maybe a
Nothing),
  compositionWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
  }

checkOmittedDefaultMultiplicities :: OmittedDefaultMultiplicities -> Maybe String
checkOmittedDefaultMultiplicities :: OmittedDefaultMultiplicities -> Maybe String
checkOmittedDefaultMultiplicities OmittedDefaultMultiplicities {Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity :: OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity :: OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity :: OmittedDefaultMultiplicities -> Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
..} =
  Maybe (Int, Maybe Int) -> Maybe String
forall {a}. (Ord a, Num a) => Maybe (a, Maybe a) -> Maybe String
checkValidity Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, Maybe Int) -> Maybe String
forall {a}. (Ord a, Num a) => Maybe (a, Maybe a) -> Maybe String
checkValidity Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, Maybe Int) -> Maybe String
forall {a}. (Ord a, Num a) => Maybe (a, Maybe a) -> Maybe String
checkCompositionValidity Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity
  where
    checkCompositionValidity :: Maybe (a, Maybe a) -> Maybe String
checkCompositionValidity limit :: Maybe (a, Maybe a)
limit@(Just (a
_, Just a
upper))
      | a
upper a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1
      = String -> Maybe String
forall a. a -> Maybe a
Just String
"The upper composition default multiplicity must not be higher than 1"
      | Bool
otherwise
      = Maybe (a, Maybe a) -> Maybe String
forall {a}. (Ord a, Num a) => Maybe (a, Maybe a) -> Maybe String
checkValidity Maybe (a, Maybe a)
limit
    checkCompositionValidity Maybe (a, Maybe a)
limit = Maybe (a, Maybe a) -> Maybe String
forall {a}. (Ord a, Num a) => Maybe (a, Maybe a) -> Maybe String
checkValidity Maybe (a, Maybe a)
limit
    checkValidity :: Maybe (a, Maybe a) -> Maybe String
checkValidity Maybe (a, Maybe a)
Nothing = Maybe String
forall a. Maybe a
Nothing
    checkValidity (Just (a
lower, Maybe a
maybeUpper))
      | a
lower a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
      = String -> Maybe String
forall a. a -> Maybe a
Just String
"The lower default multiplicity limit must not be negative."
      | Just a
upper <- Maybe a
maybeUpper, a
upper a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1
      = String -> Maybe String
forall a. a -> Maybe a
Just String
"The upper default multiplicity limit must not be lower than 1."
      | Just a
upper <- Maybe a
maybeUpper, a
upper a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
lower
      = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
        The upper default multiplicity limit must not be lower than
        the lower limit.
        |]
      | Bool
otherwise
      = Maybe String
forall a. Maybe a
Nothing

{-|
Defines the size restrictions of an object diagram.
-}
data ObjectConfig = ObjectConfig {
  -- | lower and upper limit of links within the object diagram
  ObjectConfig -> (Int, Maybe Int)
linkLimits                  :: !(Int, Maybe Int),
  -- | lower and upper limit of links starting or ending at each object
  ObjectConfig -> (Int, Maybe Int)
linksPerObjectLimits        :: !(Int, Maybe Int),
  -- | lower and upper limit of objects within the object diagram
  ObjectConfig -> (Int, Int)
objectLimits                :: !(Int, Int)
  } deriving (ObjectConfig -> ObjectConfig -> Bool
(ObjectConfig -> ObjectConfig -> Bool)
-> (ObjectConfig -> ObjectConfig -> Bool) -> Eq ObjectConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectConfig -> ObjectConfig -> Bool
== :: ObjectConfig -> ObjectConfig -> Bool
$c/= :: ObjectConfig -> ObjectConfig -> Bool
/= :: ObjectConfig -> ObjectConfig -> Bool
Eq, (forall x. ObjectConfig -> Rep ObjectConfig x)
-> (forall x. Rep ObjectConfig x -> ObjectConfig)
-> Generic ObjectConfig
forall x. Rep ObjectConfig x -> ObjectConfig
forall x. ObjectConfig -> Rep ObjectConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectConfig -> Rep ObjectConfig x
from :: forall x. ObjectConfig -> Rep ObjectConfig x
$cto :: forall x. Rep ObjectConfig x -> ObjectConfig
to :: forall x. Rep ObjectConfig x -> ObjectConfig
Generic, ReadPrec [ObjectConfig]
ReadPrec ObjectConfig
Int -> ReadS ObjectConfig
ReadS [ObjectConfig]
(Int -> ReadS ObjectConfig)
-> ReadS [ObjectConfig]
-> ReadPrec ObjectConfig
-> ReadPrec [ObjectConfig]
-> Read ObjectConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ObjectConfig
readsPrec :: Int -> ReadS ObjectConfig
$creadList :: ReadS [ObjectConfig]
readList :: ReadS [ObjectConfig]
$creadPrec :: ReadPrec ObjectConfig
readPrec :: ReadPrec ObjectConfig
$creadListPrec :: ReadPrec [ObjectConfig]
readListPrec :: ReadPrec [ObjectConfig]
Read, Int -> ObjectConfig -> ShowS
[ObjectConfig] -> ShowS
ObjectConfig -> String
(Int -> ObjectConfig -> ShowS)
-> (ObjectConfig -> String)
-> ([ObjectConfig] -> ShowS)
-> Show ObjectConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectConfig -> ShowS
showsPrec :: Int -> ObjectConfig -> ShowS
$cshow :: ObjectConfig -> String
show :: ObjectConfig -> String
$cshowList :: [ObjectConfig] -> ShowS
showList :: [ObjectConfig] -> ShowS
Show)

{-|
Defines structural constraints of an object diagram.
-}
data ObjectProperties = ObjectProperties {
  -- | a proportion in the interval 0 to 1
  -- describing what ratio of the objects should be anonymous
  -- where 0 is meaning none and 1 is meaning all
  ObjectProperties -> Rational
anonymousObjectProportion   :: !Rational,
  -- | if there is at least one object for each existing class
  ObjectProperties -> Maybe Bool
completelyInhabited         :: !(Maybe Bool),
  -- | if the number of isolated objects should be restricted
  ObjectProperties -> Bool
hasLimitedIsolatedObjects   :: !Bool,
  -- | if there are links between the same object
  ObjectProperties -> Maybe Bool
hasSelfLoops                :: !(Maybe Bool),
  -- | if there is at least one link
  -- for every association, aggregation and composition
  ObjectProperties -> Maybe Bool
usesEveryRelationshipName   :: !(Maybe Bool)
  } deriving (ObjectProperties -> ObjectProperties -> Bool
(ObjectProperties -> ObjectProperties -> Bool)
-> (ObjectProperties -> ObjectProperties -> Bool)
-> Eq ObjectProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectProperties -> ObjectProperties -> Bool
== :: ObjectProperties -> ObjectProperties -> Bool
$c/= :: ObjectProperties -> ObjectProperties -> Bool
/= :: ObjectProperties -> ObjectProperties -> Bool
Eq, (forall x. ObjectProperties -> Rep ObjectProperties x)
-> (forall x. Rep ObjectProperties x -> ObjectProperties)
-> Generic ObjectProperties
forall x. Rep ObjectProperties x -> ObjectProperties
forall x. ObjectProperties -> Rep ObjectProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectProperties -> Rep ObjectProperties x
from :: forall x. ObjectProperties -> Rep ObjectProperties x
$cto :: forall x. Rep ObjectProperties x -> ObjectProperties
to :: forall x. Rep ObjectProperties x -> ObjectProperties
Generic, ReadPrec [ObjectProperties]
ReadPrec ObjectProperties
Int -> ReadS ObjectProperties
ReadS [ObjectProperties]
(Int -> ReadS ObjectProperties)
-> ReadS [ObjectProperties]
-> ReadPrec ObjectProperties
-> ReadPrec [ObjectProperties]
-> Read ObjectProperties
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ObjectProperties
readsPrec :: Int -> ReadS ObjectProperties
$creadList :: ReadS [ObjectProperties]
readList :: ReadS [ObjectProperties]
$creadPrec :: ReadPrec ObjectProperties
readPrec :: ReadPrec ObjectProperties
$creadListPrec :: ReadPrec [ObjectProperties]
readListPrec :: ReadPrec [ObjectProperties]
Read, Int -> ObjectProperties -> ShowS
[ObjectProperties] -> ShowS
ObjectProperties -> String
(Int -> ObjectProperties -> ShowS)
-> (ObjectProperties -> String)
-> ([ObjectProperties] -> ShowS)
-> Show ObjectProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectProperties -> ShowS
showsPrec :: Int -> ObjectProperties -> ShowS
$cshow :: ObjectProperties -> String
show :: ObjectProperties -> String
$cshowList :: [ObjectProperties] -> ShowS
showList :: [ObjectProperties] -> ShowS
Show)

checkObjectProperties :: ObjectProperties -> Maybe String
checkObjectProperties :: ObjectProperties -> Maybe String
checkObjectProperties ObjectProperties {Bool
Maybe Bool
Rational
anonymousObjectProportion :: ObjectProperties -> Rational
completelyInhabited :: ObjectProperties -> Maybe Bool
hasLimitedIsolatedObjects :: ObjectProperties -> Bool
hasSelfLoops :: ObjectProperties -> Maybe Bool
usesEveryRelationshipName :: ObjectProperties -> Maybe Bool
anonymousObjectProportion :: Rational
completelyInhabited :: Maybe Bool
hasLimitedIsolatedObjects :: Bool
hasSelfLoops :: Maybe Bool
usesEveryRelationshipName :: Maybe Bool
..}
  | Rational -> Integer
forall a. Ratio a -> a
numerator Rational
anonymousObjectProportion Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    anonymousObjectProportion must be positive
    |]
  | Rational -> Integer
forall a. Ratio a -> a
numerator Rational
anonymousObjectProportion Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Rational -> Integer
forall a. Ratio a -> a
denominator Rational
anonymousObjectProportion
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    anonymousObjectProportion must be in the interval [0..1]
    |]
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing

{-|
Configuration checks for the interplay of provided class diagram
and object diagram configurations.
-}
checkClassConfigAndObjectProperties
  :: ClassConfig
  -> ObjectProperties
  -> Maybe String
checkClassConfigAndObjectProperties :: ClassConfig -> ObjectProperties -> Maybe String
checkClassConfigAndObjectProperties ClassConfig {(Int, Int)
(Int, Maybe Int)
classLimits :: ClassConfig -> (Int, Int)
aggregationLimits :: ClassConfig -> (Int, Maybe Int)
associationLimits :: ClassConfig -> (Int, Maybe Int)
compositionLimits :: ClassConfig -> (Int, Maybe Int)
inheritanceLimits :: ClassConfig -> (Int, Maybe Int)
relationshipLimits :: ClassConfig -> (Int, Maybe Int)
classLimits :: (Int, Int)
aggregationLimits :: (Int, Maybe Int)
associationLimits :: (Int, Maybe Int)
compositionLimits :: (Int, Maybe Int)
inheritanceLimits :: (Int, Maybe Int)
relationshipLimits :: (Int, Maybe Int)
..} ObjectProperties {Bool
Maybe Bool
Rational
anonymousObjectProportion :: ObjectProperties -> Rational
completelyInhabited :: ObjectProperties -> Maybe Bool
hasLimitedIsolatedObjects :: ObjectProperties -> Bool
hasSelfLoops :: ObjectProperties -> Maybe Bool
usesEveryRelationshipName :: ObjectProperties -> Maybe Bool
anonymousObjectProportion :: Rational
completelyInhabited :: Maybe Bool
hasLimitedIsolatedObjects :: Bool
hasSelfLoops :: Maybe Bool
usesEveryRelationshipName :: Maybe Bool
..}
  | Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Bool
hasSelfLoops
  , Bool
noNonInheritanceRelationshipPossible
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    Setting hasSelfLoops to anything other than Just False
    makes no sense if it is not even possible
    that at least one non-inheritance relationship can even appear
    in any underlying class diagram
    so that such a link could actually appear.
    |]
  | Just Bool
True <- Maybe Bool
hasSelfLoops
  , Bool
noNonInheritanceRelationshipGuaranteed
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    hasSelfLoops can only be enforced if there is guaranteed
    at least one non-inheritance relationship in each underlying class diagram
    so that such a link can actually appear.
    |]
  | Bool
hasLimitedIsolatedObjects
  , Bool
noNonInheritanceRelationshipGuaranteed
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    hasLimitedIsolatedObjects can only be enabled if there is guaranteed
    at least one non-inheritance relationship in each underlying class diagram
    so that links can actually be present between objects.
    |]
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing
  where
    nonInheritanceLimits :: [(Int, Maybe Int)]
nonInheritanceLimits =
      [(Int, Maybe Int)
aggregationLimits, (Int, Maybe Int)
associationLimits, (Int, Maybe Int)
compositionLimits]
    noNonInheritanceRelationshipGuaranteed :: Bool
noNonInheritanceRelationshipGuaranteed =
      (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
relationshipLimits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst (Int, Maybe Int)
inheritanceLimits
      Bool -> Bool -> Bool
|| ((Int, Maybe Int) -> Bool) -> [(Int, Maybe Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) (Int -> Bool)
-> ((Int, Maybe Int) -> Int) -> (Int, Maybe Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst) [(Int, Maybe Int)]
nonInheritanceLimits
    noNonInheritanceRelationshipPossible :: Bool
noNonInheritanceRelationshipPossible =
      ((Int, Maybe Int) -> Bool) -> [(Int, Maybe Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) (Maybe Int -> Bool)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) [(Int, Maybe Int)]
nonInheritanceLimits

{-|
Defines an 'ObjectConfig' demanding at least one but at most five objects
without restricting links.
-}
maxFiveObjects :: ObjectConfig
maxFiveObjects :: ObjectConfig
maxFiveObjects = Int -> ObjectConfig
maxObjects Int
5

{-|
Defines an 'ObjectConfig' demanding at least one but at most the given number of
objects without restricting links.
-}
maxObjects :: Int -> ObjectConfig
maxObjects :: Int -> ObjectConfig
maxObjects Int
x = ObjectConfig {
  linkLimits :: (Int, Maybe Int)
linkLimits                  = (Int
0, Maybe Int
forall a. Maybe a
Nothing),
  linksPerObjectLimits :: (Int, Maybe Int)
linksPerObjectLimits        = (Int
0, Maybe Int
forall a. Maybe a
Nothing),
  objectLimits :: (Int, Int)
objectLimits                = (Int
1, Int
x)
  }

data RelationshipProperties
  = RelationshipProperties {
    RelationshipProperties -> Int
invalidInheritances     :: !Int,
    RelationshipProperties -> Int
wrongNonInheritances    :: Int,
    RelationshipProperties -> Int
wrongCompositions       :: Int,
    RelationshipProperties -> Int
selfRelationshipsAmount :: Int,
    RelationshipProperties -> Int
selfInheritancesAmount  :: Int,
    RelationshipProperties -> Maybe Bool
hasDoubleRelationships  :: Maybe Bool,
    RelationshipProperties -> Maybe Bool
hasReverseRelationships :: Maybe Bool,
    RelationshipProperties -> Bool
hasReverseInheritances  :: Bool,
    RelationshipProperties -> Maybe Bool
hasMultipleInheritances :: Maybe Bool,
    RelationshipProperties -> Bool
hasNonTrivialInheritanceCycles :: Bool,
    RelationshipProperties -> Bool
hasCompositionCycles    :: Bool,
    RelationshipProperties -> Maybe Bool
hasCompositionsPreventingParts :: Maybe Bool,
    RelationshipProperties -> Maybe Bool
hasThickEdges           :: Maybe Bool
  } deriving ((forall x. RelationshipProperties -> Rep RelationshipProperties x)
-> (forall x.
    Rep RelationshipProperties x -> RelationshipProperties)
-> Generic RelationshipProperties
forall x. Rep RelationshipProperties x -> RelationshipProperties
forall x. RelationshipProperties -> Rep RelationshipProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelationshipProperties -> Rep RelationshipProperties x
from :: forall x. RelationshipProperties -> Rep RelationshipProperties x
$cto :: forall x. Rep RelationshipProperties x -> RelationshipProperties
to :: forall x. Rep RelationshipProperties x -> RelationshipProperties
Generic, ReadPrec [RelationshipProperties]
ReadPrec RelationshipProperties
Int -> ReadS RelationshipProperties
ReadS [RelationshipProperties]
(Int -> ReadS RelationshipProperties)
-> ReadS [RelationshipProperties]
-> ReadPrec RelationshipProperties
-> ReadPrec [RelationshipProperties]
-> Read RelationshipProperties
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RelationshipProperties
readsPrec :: Int -> ReadS RelationshipProperties
$creadList :: ReadS [RelationshipProperties]
readList :: ReadS [RelationshipProperties]
$creadPrec :: ReadPrec RelationshipProperties
readPrec :: ReadPrec RelationshipProperties
$creadListPrec :: ReadPrec [RelationshipProperties]
readListPrec :: ReadPrec [RelationshipProperties]
Read, Int -> RelationshipProperties -> ShowS
[RelationshipProperties] -> ShowS
RelationshipProperties -> String
(Int -> RelationshipProperties -> ShowS)
-> (RelationshipProperties -> String)
-> ([RelationshipProperties] -> ShowS)
-> Show RelationshipProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationshipProperties -> ShowS
showsPrec :: Int -> RelationshipProperties -> ShowS
$cshow :: RelationshipProperties -> String
show :: RelationshipProperties -> String
$cshowList :: [RelationshipProperties] -> ShowS
showList :: [RelationshipProperties] -> ShowS
Show)

defaultProperties :: RelationshipProperties
defaultProperties :: RelationshipProperties
defaultProperties =
  RelationshipProperties {
    invalidInheritances :: Int
invalidInheritances     = Int
0,
    wrongNonInheritances :: Int
wrongNonInheritances    = Int
0,
    wrongCompositions :: Int
wrongCompositions       = Int
0,
    selfRelationshipsAmount :: Int
selfRelationshipsAmount = Int
0,
    selfInheritancesAmount :: Int
selfInheritancesAmount  = Int
0,
    hasDoubleRelationships :: Maybe Bool
hasDoubleRelationships  = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    hasReverseRelationships :: Maybe Bool
hasReverseRelationships = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    hasReverseInheritances :: Bool
hasReverseInheritances  = Bool
False,
    hasMultipleInheritances :: Maybe Bool
hasMultipleInheritances = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    hasNonTrivialInheritanceCycles :: Bool
hasNonTrivialInheritanceCycles = Bool
False,
    hasCompositionCycles :: Bool
hasCompositionCycles    = Bool
False,
    hasCompositionsPreventingParts :: Maybe Bool
hasCompositionsPreventingParts = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    hasThickEdges :: Maybe Bool
hasThickEdges           = Maybe Bool
forall a. Maybe a
Nothing
  }

towardsValidProperties :: RelationshipProperties -> RelationshipProperties
towardsValidProperties :: RelationshipProperties -> RelationshipProperties
towardsValidProperties properties :: RelationshipProperties
properties@RelationshipProperties {Bool
Int
Maybe Bool
invalidInheritances :: RelationshipProperties -> Int
wrongNonInheritances :: RelationshipProperties -> Int
wrongCompositions :: RelationshipProperties -> Int
selfRelationshipsAmount :: RelationshipProperties -> Int
selfInheritancesAmount :: RelationshipProperties -> Int
hasDoubleRelationships :: RelationshipProperties -> Maybe Bool
hasReverseRelationships :: RelationshipProperties -> Maybe Bool
hasReverseInheritances :: RelationshipProperties -> Bool
hasMultipleInheritances :: RelationshipProperties -> Maybe Bool
hasNonTrivialInheritanceCycles :: RelationshipProperties -> Bool
hasCompositionCycles :: RelationshipProperties -> Bool
hasCompositionsPreventingParts :: RelationshipProperties -> Maybe Bool
hasThickEdges :: RelationshipProperties -> Maybe Bool
invalidInheritances :: Int
wrongNonInheritances :: Int
wrongCompositions :: Int
selfRelationshipsAmount :: Int
selfInheritancesAmount :: Int
hasDoubleRelationships :: Maybe Bool
hasReverseRelationships :: Maybe Bool
hasReverseInheritances :: Bool
hasMultipleInheritances :: Maybe Bool
hasNonTrivialInheritanceCycles :: Bool
hasCompositionCycles :: Bool
hasCompositionsPreventingParts :: Maybe Bool
hasThickEdges :: Maybe Bool
..} = RelationshipProperties
properties {
  invalidInheritances :: Int
invalidInheritances = (Bool, Int) -> Int
forall a b. (a, b) -> b
snd (Bool, Int)
betterInvalidInheritances,
  wrongNonInheritances :: Int
wrongNonInheritances = (Bool, Int) -> Int
forall a b. (a, b) -> b
snd (Bool, Int)
betterWrongNonInheritances,
  wrongCompositions :: Int
wrongCompositions = (Bool, Int) -> Int
forall a b. (a, b) -> b
snd (Bool, Int)
betterWrongCompositions,
  selfInheritancesAmount :: Int
selfInheritancesAmount = (Bool, Int) -> Int
forall a b. (a, b) -> b
snd (Bool, Int)
betterSelfInheritances,
  hasReverseInheritances :: Bool
hasReverseInheritances = (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Bool, Bool)
fixedReverseInheritances,
  hasNonTrivialInheritanceCycles :: Bool
hasNonTrivialInheritanceCycles = (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Bool, Bool)
fixedNonTrivialInheritanceCycles,
  hasCompositionCycles :: Bool
hasCompositionCycles = (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Bool, Bool)
fixedCompositionCycles
  }
  where
    betterInvalidInheritances :: (Bool, Int)
betterInvalidInheritances = Bool -> Int -> (Bool, Int)
forall {a}. (Ord a, Num a) => Bool -> a -> (Bool, a)
hasBetter Bool
False Int
invalidInheritances
    betterWrongNonInheritances :: (Bool, Int)
betterWrongNonInheritances =
      Bool -> Int -> (Bool, Int)
forall {a}. (Ord a, Num a) => Bool -> a -> (Bool, a)
hasBetter ((Bool, Int) -> Bool
forall a b. (a, b) -> a
fst (Bool, Int)
betterInvalidInheritances) Int
wrongNonInheritances
    betterWrongCompositions :: (Bool, Int)
betterWrongCompositions =
      Bool -> Int -> (Bool, Int)
forall {a}. (Ord a, Num a) => Bool -> a -> (Bool, a)
hasBetter ((Bool, Int) -> Bool
forall a b. (a, b) -> a
fst (Bool, Int)
betterWrongNonInheritances) Int
wrongCompositions
    betterSelfInheritances :: (Bool, Int)
betterSelfInheritances =
      Bool -> Int -> (Bool, Int)
forall {a}. (Ord a, Num a) => Bool -> a -> (Bool, a)
hasBetter ((Bool, Int) -> Bool
forall a b. (a, b) -> a
fst (Bool, Int)
betterWrongCompositions) Int
selfInheritancesAmount
    fixedReverseInheritances :: (Bool, Bool)
fixedReverseInheritances =
      Bool -> Bool -> (Bool, Bool)
fixed ((Bool, Int) -> Bool
forall a b. (a, b) -> a
fst (Bool, Int)
betterSelfInheritances) Bool
hasReverseInheritances
    fixedNonTrivialInheritanceCycles :: (Bool, Bool)
fixedNonTrivialInheritanceCycles =
      Bool -> Bool -> (Bool, Bool)
fixed ((Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst (Bool, Bool)
fixedReverseInheritances) Bool
hasNonTrivialInheritanceCycles
    fixedCompositionCycles :: (Bool, Bool)
fixedCompositionCycles =
      Bool -> Bool -> (Bool, Bool)
fixed ((Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst (Bool, Bool)
fixedNonTrivialInheritanceCycles) Bool
hasCompositionCycles
    hasBetter :: Bool -> a -> (Bool, a)
hasBetter Bool
True a
x = (Bool
True, a
x)
    hasBetter Bool
False a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then (Bool
True, a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
1) else (Bool
False, a
x)
    fixed :: Bool -> Bool -> (Bool, Bool)
fixed Bool
True Bool
x = (Bool
True, Bool
x)
    fixed Bool
False Bool
x = (Bool
x, Bool
False)

data Property =
    CompositionCycles
  | DoubleRelationships
  | InheritanceCycles
  | InvalidInheritanceLimits
  | MultipleInheritances
  | ReverseInheritances
  | ReverseRelationships
  | SelfInheritances
  | SelfRelationships
  | WrongAssociationLimits
  | WrongCompositionLimits
  deriving (Property
Property -> Property -> Bounded Property
forall a. a -> a -> Bounded a
$cminBound :: Property
minBound :: Property
$cmaxBound :: Property
maxBound :: Property
Bounded, Typeable Property
Typeable Property
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Property -> c Property)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Property)
-> (Property -> Constr)
-> (Property -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Property))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Property))
-> ((forall b. Data b => b -> b) -> Property -> Property)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Property -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Property -> r)
-> (forall u. (forall d. Data d => d -> u) -> Property -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Property -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Property -> m Property)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Property -> m Property)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Property -> m Property)
-> Data Property
Property -> Constr
Property -> DataType
(forall b. Data b => b -> b) -> Property -> Property
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Property -> u
forall u. (forall d. Data d => d -> u) -> Property -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Property -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Property -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Property -> m Property
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Property -> m Property
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Property
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Property -> c Property
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Property)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Property)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Property -> c Property
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Property -> c Property
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Property
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Property
$ctoConstr :: Property -> Constr
toConstr :: Property -> Constr
$cdataTypeOf :: Property -> DataType
dataTypeOf :: Property -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Property)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Property)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Property)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Property)
$cgmapT :: (forall b. Data b => b -> b) -> Property -> Property
gmapT :: (forall b. Data b => b -> b) -> Property -> Property
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Property -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Property -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Property -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Property -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Property -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Property -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Property -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Property -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Property -> m Property
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Property -> m Property
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Property -> m Property
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Property -> m Property
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Property -> m Property
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Property -> m Property
Data, Int -> Property
Property -> Int
Property -> [Property]
Property -> Property
Property -> Property -> [Property]
Property -> Property -> Property -> [Property]
(Property -> Property)
-> (Property -> Property)
-> (Int -> Property)
-> (Property -> Int)
-> (Property -> [Property])
-> (Property -> Property -> [Property])
-> (Property -> Property -> [Property])
-> (Property -> Property -> Property -> [Property])
-> Enum Property
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Property -> Property
succ :: Property -> Property
$cpred :: Property -> Property
pred :: Property -> Property
$ctoEnum :: Int -> Property
toEnum :: Int -> Property
$cfromEnum :: Property -> Int
fromEnum :: Property -> Int
$cenumFrom :: Property -> [Property]
enumFrom :: Property -> [Property]
$cenumFromThen :: Property -> Property -> [Property]
enumFromThen :: Property -> Property -> [Property]
$cenumFromTo :: Property -> Property -> [Property]
enumFromTo :: Property -> Property -> [Property]
$cenumFromThenTo :: Property -> Property -> Property -> [Property]
enumFromThenTo :: Property -> Property -> Property -> [Property]
Enum, Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq, (forall x. Property -> Rep Property x)
-> (forall x. Rep Property x -> Property) -> Generic Property
forall x. Rep Property x -> Property
forall x. Property -> Rep Property x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Property -> Rep Property x
from :: forall x. Property -> Rep Property x
$cto :: forall x. Rep Property x -> Property
to :: forall x. Rep Property x -> Property
Generic, Eq Property
Eq Property
-> (Property -> Property -> Ordering)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Property)
-> (Property -> Property -> Property)
-> Ord Property
Property -> Property -> Bool
Property -> Property -> Ordering
Property -> Property -> Property
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
$ccompare :: Property -> Property -> Ordering
compare :: Property -> Property -> Ordering
$c< :: Property -> Property -> Bool
< :: Property -> Property -> Bool
$c<= :: Property -> Property -> Bool
<= :: Property -> Property -> Bool
$c> :: Property -> Property -> Bool
> :: Property -> Property -> Bool
$c>= :: Property -> Property -> Bool
>= :: Property -> Property -> Bool
$cmax :: Property -> Property -> Property
max :: Property -> Property -> Property
$cmin :: Property -> Property -> Property
min :: Property -> Property -> Property
Ord, ReadPrec [Property]
ReadPrec Property
Int -> ReadS Property
ReadS [Property]
(Int -> ReadS Property)
-> ReadS [Property]
-> ReadPrec Property
-> ReadPrec [Property]
-> Read Property
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Property
readsPrec :: Int -> ReadS Property
$creadList :: ReadS [Property]
readList :: ReadS [Property]
$creadPrec :: ReadPrec Property
readPrec :: ReadPrec Property
$creadListPrec :: ReadPrec [Property]
readListPrec :: ReadPrec [Property]
Read, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Property -> ShowS
showsPrec :: Int -> Property -> ShowS
$cshow :: Property -> String
show :: Property -> String
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show)

isIllegal :: Property -> Bool
isIllegal :: Property -> Bool
isIllegal Property
x = case Property
x of
  Property
CompositionCycles -> Bool
True
  Property
DoubleRelationships -> Bool
False
  Property
InheritanceCycles -> Bool
True
  Property
InvalidInheritanceLimits -> Bool
True
  Property
MultipleInheritances -> Bool
False
  Property
ReverseInheritances -> Bool
True
  Property
ReverseRelationships -> Bool
False
  Property
SelfInheritances -> Bool
True
  Property
SelfRelationships -> Bool
False
  Property
WrongAssociationLimits -> Bool
True
  Property
WrongCompositionLimits -> Bool
True

{-|
Create a set of properties based on a 'RelationshipProperties' configuration.
-}
toPropertySet :: RelationshipProperties -> Set Property
toPropertySet :: RelationshipProperties -> Set Property
toPropertySet RelationshipProperties {Bool
Int
Maybe Bool
invalidInheritances :: RelationshipProperties -> Int
wrongNonInheritances :: RelationshipProperties -> Int
wrongCompositions :: RelationshipProperties -> Int
selfRelationshipsAmount :: RelationshipProperties -> Int
selfInheritancesAmount :: RelationshipProperties -> Int
hasDoubleRelationships :: RelationshipProperties -> Maybe Bool
hasReverseRelationships :: RelationshipProperties -> Maybe Bool
hasReverseInheritances :: RelationshipProperties -> Bool
hasMultipleInheritances :: RelationshipProperties -> Maybe Bool
hasNonTrivialInheritanceCycles :: RelationshipProperties -> Bool
hasCompositionCycles :: RelationshipProperties -> Bool
hasCompositionsPreventingParts :: RelationshipProperties -> Maybe Bool
hasThickEdges :: RelationshipProperties -> Maybe Bool
invalidInheritances :: Int
wrongNonInheritances :: Int
wrongCompositions :: Int
selfRelationshipsAmount :: Int
selfInheritancesAmount :: Int
hasDoubleRelationships :: Maybe Bool
hasReverseRelationships :: Maybe Bool
hasReverseInheritances :: Bool
hasMultipleInheritances :: Maybe Bool
hasNonTrivialInheritanceCycles :: Bool
hasCompositionCycles :: Bool
hasCompositionsPreventingParts :: Maybe Bool
hasThickEdges :: Maybe Bool
..} =
  [Property] -> Set Property
forall a. Ord a => [a] -> Set a
S.fromList ([Property] -> Set Property) -> [Property] -> Set Property
forall a b. (a -> b) -> a -> b
$ [Maybe Property] -> [Property]
forall a. [Maybe a] -> [a]
catMaybes [
    Bool -> Property -> Maybe Property
forall {a}. Bool -> a -> Maybe a
ifTrue Bool
hasCompositionCycles Property
CompositionCycles,
    Maybe Bool -> Property -> Maybe Property
forall {a}. Maybe Bool -> a -> Maybe a
ifJustTrue Maybe Bool
hasDoubleRelationships Property
DoubleRelationships,
    Bool -> Property -> Maybe Property
forall {a}. Bool -> a -> Maybe a
ifTrue Bool
hasNonTrivialInheritanceCycles Property
InheritanceCycles,
    Maybe Bool -> Property -> Maybe Property
forall {a}. Maybe Bool -> a -> Maybe a
ifJustTrue Maybe Bool
hasMultipleInheritances Property
MultipleInheritances,
    Bool -> Property -> Maybe Property
forall {a}. Bool -> a -> Maybe a
ifTrue Bool
hasReverseInheritances Property
ReverseInheritances,
    Maybe Bool -> Property -> Maybe Property
forall {a}. Maybe Bool -> a -> Maybe a
ifJustTrue Maybe Bool
hasReverseRelationships Property
ReverseRelationships,
    Int -> Property -> Maybe Property
forall {a} {a}. (Ord a, Num a) => a -> a -> Maybe a
ifAny Int
selfInheritancesAmount Property
SelfInheritances,
    Int -> Property -> Maybe Property
forall {a} {a}. (Ord a, Num a) => a -> a -> Maybe a
ifAny Int
selfRelationshipsAmount Property
SelfRelationships,
    Int -> Property -> Maybe Property
forall {a} {a}. (Ord a, Num a) => a -> a -> Maybe a
ifAny Int
invalidInheritances Property
InvalidInheritanceLimits,
    Int -> Property -> Maybe Property
forall {a} {a}. (Ord a, Num a) => a -> a -> Maybe a
ifAny Int
wrongNonInheritances Property
WrongAssociationLimits,
    Int -> Property -> Maybe Property
forall {a} {a}. (Ord a, Num a) => a -> a -> Maybe a
ifAny Int
wrongCompositions Property
WrongCompositionLimits
    ]
  where
    ifAny :: a -> a -> Maybe a
ifAny a
x a
p = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then a -> Maybe a
forall a. a -> Maybe a
Just a
p else Maybe a
forall a. Maybe a
Nothing
    ifTrue :: Bool -> a -> Maybe a
ifTrue Bool
x a
p = if Bool
x then a -> Maybe a
forall a. a -> Maybe a
Just a
p else Maybe a
forall a. Maybe a
Nothing
    ifJustTrue :: Maybe Bool -> a -> Maybe a
ifJustTrue Maybe Bool
Nothing a
_ = Maybe a
forall a. Maybe a
Nothing
    ifJustTrue (Just Bool
x) a
p = Bool -> a -> Maybe a
forall {a}. Bool -> a -> Maybe a
ifTrue Bool
x a
p

data AllowedProperties = AllowedProperties {
  AllowedProperties -> Bool
compositionCycles           :: Bool,
  AllowedProperties -> Bool
doubleRelationships         :: Bool,
  AllowedProperties -> Bool
inheritanceCycles           :: Bool,
  AllowedProperties -> Bool
invalidInheritanceLimits    :: Bool,
  AllowedProperties -> Bool
reverseInheritances         :: Bool,
  AllowedProperties -> Bool
reverseRelationships        :: Bool,
  AllowedProperties -> Bool
selfInheritances            :: Bool,
  AllowedProperties -> Bool
selfRelationships           :: Bool,
  AllowedProperties -> Bool
wrongAssociationLimits      :: Bool,
  AllowedProperties -> Bool
wrongCompositionLimits      :: Bool
  } deriving ((forall x. AllowedProperties -> Rep AllowedProperties x)
-> (forall x. Rep AllowedProperties x -> AllowedProperties)
-> Generic AllowedProperties
forall x. Rep AllowedProperties x -> AllowedProperties
forall x. AllowedProperties -> Rep AllowedProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AllowedProperties -> Rep AllowedProperties x
from :: forall x. AllowedProperties -> Rep AllowedProperties x
$cto :: forall x. Rep AllowedProperties x -> AllowedProperties
to :: forall x. Rep AllowedProperties x -> AllowedProperties
Generic, ReadPrec [AllowedProperties]
ReadPrec AllowedProperties
Int -> ReadS AllowedProperties
ReadS [AllowedProperties]
(Int -> ReadS AllowedProperties)
-> ReadS [AllowedProperties]
-> ReadPrec AllowedProperties
-> ReadPrec [AllowedProperties]
-> Read AllowedProperties
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AllowedProperties
readsPrec :: Int -> ReadS AllowedProperties
$creadList :: ReadS [AllowedProperties]
readList :: ReadS [AllowedProperties]
$creadPrec :: ReadPrec AllowedProperties
readPrec :: ReadPrec AllowedProperties
$creadListPrec :: ReadPrec [AllowedProperties]
readListPrec :: ReadPrec [AllowedProperties]
Read, Int -> AllowedProperties -> ShowS
[AllowedProperties] -> ShowS
AllowedProperties -> String
(Int -> AllowedProperties -> ShowS)
-> (AllowedProperties -> String)
-> ([AllowedProperties] -> ShowS)
-> Show AllowedProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowedProperties -> ShowS
showsPrec :: Int -> AllowedProperties -> ShowS
$cshow :: AllowedProperties -> String
show :: AllowedProperties -> String
$cshowList :: [AllowedProperties] -> ShowS
showList :: [AllowedProperties] -> ShowS
Show)

allowEverything :: AllowedProperties
allowEverything :: AllowedProperties
allowEverything = AllowedProperties {
  compositionCycles :: Bool
compositionCycles           = Bool
True,
  doubleRelationships :: Bool
doubleRelationships         = Bool
True,
  inheritanceCycles :: Bool
inheritanceCycles           = Bool
True,
  invalidInheritanceLimits :: Bool
invalidInheritanceLimits    = Bool
True,
  reverseInheritances :: Bool
reverseInheritances         = Bool
True,
  reverseRelationships :: Bool
reverseRelationships        = Bool
True,
  selfInheritances :: Bool
selfInheritances            = Bool
True,
  selfRelationships :: Bool
selfRelationships           = Bool
True,
  wrongAssociationLimits :: Bool
wrongAssociationLimits      = Bool
True,
  wrongCompositionLimits :: Bool
wrongCompositionLimits      = Bool
True
  }

allowNothing :: AllowedProperties
allowNothing :: AllowedProperties
allowNothing = AllowedProperties {
  compositionCycles :: Bool
compositionCycles           = Bool
False,
  doubleRelationships :: Bool
doubleRelationships         = Bool
False,
  inheritanceCycles :: Bool
inheritanceCycles           = Bool
False,
  invalidInheritanceLimits :: Bool
invalidInheritanceLimits    = Bool
False,
  reverseInheritances :: Bool
reverseInheritances         = Bool
False,
  reverseRelationships :: Bool
reverseRelationships        = Bool
False,
  selfInheritances :: Bool
selfInheritances            = Bool
False,
  selfRelationships :: Bool
selfRelationships           = Bool
False,
  wrongAssociationLimits :: Bool
wrongAssociationLimits      = Bool
False,
  wrongCompositionLimits :: Bool
wrongCompositionLimits      = Bool
False
  }

associationNames :: Cd -> [String]
associationNames :: Cd -> [String]
associationNames = (Relationship String String -> Maybe String)
-> [Relationship String String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Relationship String String -> Maybe String
forall c r. Relationship c r -> Maybe r
relationshipName ([Relationship String String] -> [String])
-> (Cd -> [Relationship String String]) -> Cd -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cd -> [Relationship String String]
forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships

anyAssociationNames :: AnyCd -> [String]
anyAssociationNames :: AnyCd -> [String]
anyAssociationNames = (AnyRelationship String String -> Maybe String)
-> [AnyRelationship String String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnyRelationship String String -> Maybe String
forall {className} {relationshipName} {c}.
Either
  (InvalidRelationship className relationshipName)
  (Relationship c relationshipName)
-> Maybe relationshipName
names ([AnyRelationship String String] -> [String])
-> (AnyCd -> [AnyRelationship String String]) -> AnyCd -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  AnyCd -> [AnyRelationship String String]
forall className relationshipName.
AnyClassDiagram className relationshipName
-> [AnyRelationship className relationshipName]
anyRelationships
  where
    names :: Either
  (InvalidRelationship className relationshipName)
  (Relationship c relationshipName)
-> Maybe relationshipName
names = (InvalidRelationship className relationshipName
 -> Maybe relationshipName)
-> (Relationship c relationshipName -> Maybe relationshipName)
-> Either
     (InvalidRelationship className relationshipName)
     (Relationship c relationshipName)
-> Maybe relationshipName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either InvalidRelationship className relationshipName
-> Maybe relationshipName
forall className relationshipName.
InvalidRelationship className relationshipName
-> Maybe relationshipName
invalidRelationshipName Relationship c relationshipName -> Maybe relationshipName
forall c r. Relationship c r -> Maybe r
relationshipName

classNamesOd
  :: Ord className
  => ObjectDiagram objectName className linkLabel
  -> [className]
classNamesOd :: forall className objectName linkLabel.
Ord className =>
ObjectDiagram objectName className linkLabel -> [className]
classNamesOd ObjectDiagram {[Link objectName linkLabel]
[Object objectName className]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object objectName className]
links :: [Link objectName linkLabel]
..} = [className] -> [className]
forall a. Ord a => [a] -> [a]
nubOrd ([className] -> [className]) -> [className] -> [className]
forall a b. (a -> b) -> a -> b
$ (Object objectName className -> className)
-> [Object objectName className] -> [className]
forall a b. (a -> b) -> [a] -> [b]
map Object objectName className -> className
forall objectName className.
Object objectName className -> className
objectClass [Object objectName className]
objects

linkLabels
  :: Ord linkLabel
  => ObjectDiagram objectName className linkLabel
  -> [linkLabel]
linkLabels :: forall linkLabel objectName className.
Ord linkLabel =>
ObjectDiagram objectName className linkLabel -> [linkLabel]
linkLabels ObjectDiagram {[Link objectName linkLabel]
[Object objectName className]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object objectName className]
links :: [Link objectName linkLabel]
..} = [linkLabel] -> [linkLabel]
forall a. Ord a => [a] -> [a]
nubOrd ([linkLabel] -> [linkLabel]) -> [linkLabel] -> [linkLabel]
forall a b. (a -> b) -> a -> b
$ (Link objectName linkLabel -> linkLabel)
-> [Link objectName linkLabel] -> [linkLabel]
forall a b. (a -> b) -> [a] -> [b]
map Link objectName linkLabel -> linkLabel
forall objectName linkLabel. Link objectName linkLabel -> linkLabel
linkLabel [Link objectName linkLabel]
links

{-|
Given a collection of CDs use all used class and relationship names
and shuffle them respectively.
-}
shuffleCdNames
  :: (MonadRandom m, Traversable t, MonadThrow m)
  => t Cd
  -> m (t Cd)
shuffleCdNames :: forall (m :: * -> *) (t :: * -> *).
(MonadRandom m, Traversable t, MonadThrow m) =>
t Cd -> m (t Cd)
shuffleCdNames t Cd
cds = do
  let names :: [String]
names = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Cd -> [String]) -> t Cd -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cd -> [String]
forall className relationshipName.
ClassDiagram className relationshipName -> [className]
classNames t Cd
cds
      nonInheritances :: [String]
nonInheritances = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Cd -> [String]) -> t Cd -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cd -> [String]
associationNames t Cd
cds
  [String]
names' <- [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
names
  [String]
nonInheritances' <- [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
nonInheritances
  let bmNames :: Bimap String String
bmNames  = [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList ([(String, String)] -> Bimap String String)
-> [(String, String)] -> Bimap String String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [String]
names'
      bmNonInheritances :: Bimap String String
bmNonInheritances = [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList ([(String, String)] -> Bimap String String)
-> [(String, String)] -> Bimap String String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
nonInheritances [String]
nonInheritances'
      renameCds :: Cd -> m Cd
renameCds = Bimap String String -> Bimap String String -> Cd -> m Cd
forall (f :: * -> * -> *) (m :: * -> *) c c' r r'.
(Bitraversable f, MonadThrow m, Ord c, Ord c', Ord r, Ord r') =>
Bimap c c' -> Bimap r r' -> f c r -> m (f c' r')
renameClassesAndRelationships Bimap String String
bmNames Bimap String String
bmNonInheritances
  (Cd -> m Cd) -> t Cd -> m (t Cd)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM Cd -> m Cd
renameCds t Cd
cds

{-|
Renaming 'AnnotatedClassDiagram'gs, `ClassDiagram`s and `Relationship`s
is possible using this function
-}
renameClassesAndRelationships
  :: (Bitraversable f, MonadThrow m, Ord c, Ord c', Ord r, Ord r')
  => Bimap c c'
  -> Bimap r r'
  -> f c r
  -> m (f c' r')
renameClassesAndRelationships :: forall (f :: * -> * -> *) (m :: * -> *) c c' r r'.
(Bitraversable f, MonadThrow m, Ord c, Ord c', Ord r, Ord r') =>
Bimap c c' -> Bimap r r' -> f c r -> m (f c' r')
renameClassesAndRelationships Bimap c c'
cm Bimap r r'
rm =
  (c -> m c') -> (r -> m r') -> f c r -> m (f c' r')
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> f a b -> f (f c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (c -> Bimap c c' -> m c'
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
`BM.lookup` Bimap c c'
cm) (r -> Bimap r r' -> m r'
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
`BM.lookup` Bimap r r'
rm)

data RenameException
  = ObjectNameNotMatchingToObjectClass
  deriving Int -> RenameException -> ShowS
[RenameException] -> ShowS
RenameException -> String
(Int -> RenameException -> ShowS)
-> (RenameException -> String)
-> ([RenameException] -> ShowS)
-> Show RenameException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenameException -> ShowS
showsPrec :: Int -> RenameException -> ShowS
$cshow :: RenameException -> String
show :: RenameException -> String
$cshowList :: [RenameException] -> ShowS
showList :: [RenameException] -> ShowS
Show

instance Exception RenameException

renameObjectsWithClassesAndLinksInOd
  :: (MonadThrow m, Ord linkLabels, Ord linkLabels')
  => Bimap String String
  -> Bimap linkLabels linkLabels'
  -> ObjectDiagram String String linkLabels
  -> m (ObjectDiagram String String linkLabels')
renameObjectsWithClassesAndLinksInOd :: forall (m :: * -> *) linkLabels linkLabels'.
(MonadThrow m, Ord linkLabels, Ord linkLabels') =>
Bimap String String
-> Bimap linkLabels linkLabels'
-> ObjectDiagram String String linkLabels
-> m (ObjectDiagram String String linkLabels')
renameObjectsWithClassesAndLinksInOd Bimap String String
bmClasses Bimap linkLabels linkLabels'
bmLinks ObjectDiagram {[Link String linkLabels]
[Object String String]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object String String]
links :: [Link String linkLabels]
..} = do
  [Object String String]
objects' <- (Object String String -> m (Object String String))
-> [Object String String] -> m [Object String String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Object String String -> m (Object String String)
forall {m :: * -> *}.
MonadThrow m =>
Object String String -> m (Object String String)
renameObject [Object String String]
objects
  let bmObjects :: Bimap String String
bmObjects = [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList
        ([(String, String)] -> Bimap String String)
-> [(String, String)] -> Bimap String String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Object String String -> String)
-> [Object String String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Object String String -> String
forall objectName className.
Object objectName className -> objectName
objectName [Object String String]
objects) ((Object String String -> String)
-> [Object String String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Object String String -> String
forall objectName className.
Object objectName className -> objectName
objectName [Object String String]
objects')
  [Link String linkLabels']
links' <- (Link String linkLabels -> m (Link String linkLabels'))
-> [Link String linkLabels] -> m [Link String linkLabels']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
    ((String -> m String)
-> (linkLabels -> m linkLabels')
-> Link String linkLabels
-> m (Link String linkLabels')
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Link a b -> f (Link c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (String -> Bimap String String -> m String
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
`BM.lookup` Bimap String String
bmObjects) (linkLabels -> Bimap linkLabels linkLabels' -> m linkLabels'
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
`BM.lookup` Bimap linkLabels linkLabels'
bmLinks))
    [Link String linkLabels]
links
  ObjectDiagram String String linkLabels'
-> m (ObjectDiagram String String linkLabels')
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ObjectDiagram {
    objects :: [Object String String]
objects = [Object String String]
objects',
    links :: [Link String linkLabels']
links = [Link String linkLabels']
links'
    }
  where
    renameObject :: Object String String -> m (Object String String)
renameObject Object {Bool
String
isAnonymous :: forall objectName className. Object objectName className -> Bool
objectName :: forall objectName className.
Object objectName className -> objectName
objectClass :: forall objectName className.
Object objectName className -> className
isAnonymous :: Bool
objectName :: String
objectClass :: String
..} = do
      String
className' <- String -> Bimap String String -> m String
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
BM.lookup String
objectClass Bimap String String
bmClasses
      case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (ShowS
lowerFirst String
objectClass) String
objectName of
        Just String
objectNamePostfix -> Object String String -> m (Object String String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Object {
          isAnonymous :: Bool
isAnonymous = Bool
isAnonymous,
          objectName :: String
objectName = ShowS
lowerFirst String
className' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
objectNamePostfix,
          objectClass :: String
objectClass = String
className'
          }
        Maybe String
Nothing -> RenameException -> m (Object String String)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM RenameException
ObjectNameNotMatchingToObjectClass

anonymiseObjects
  :: MonadRandom m
  => Rational
  -> ObjectDiagram className relationshipName linkLabel
  -> m (ObjectDiagram className relationshipName linkLabel)
anonymiseObjects :: forall (m :: * -> *) className relationshipName linkLabel.
MonadRandom m =>
Rational
-> ObjectDiagram className relationshipName linkLabel
-> m (ObjectDiagram className relationshipName linkLabel)
anonymiseObjects Rational
proportion ObjectDiagram {[Link className linkLabel]
[Object className relationshipName]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object className relationshipName]
links :: [Link className linkLabel]
..} = do
  let objectCount :: Int
objectCount = [Object className relationshipName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Object className relationshipName]
objects
      anonymous :: Int
anonymous = Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
objectCount Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
proportion)
  [Bool]
makeAnonymousList <- [Bool] -> m [Bool]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM
    ([Bool] -> m [Bool]) -> [Bool] -> m [Bool]
forall a b. (a -> b) -> a -> b
$ Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
objectCount ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
anonymous Bool
True [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False
  ObjectDiagram className relationshipName linkLabel
-> m (ObjectDiagram className relationshipName linkLabel)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ObjectDiagram {
    links :: [Link className linkLabel]
links = [Link className linkLabel]
links,
    objects :: [Object className relationshipName]
objects = (Bool
 -> Object className relationshipName
 -> Object className relationshipName)
-> [Bool]
-> [Object className relationshipName]
-> [Object className relationshipName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool
-> Object className relationshipName
-> Object className relationshipName
forall a b. Bool -> Object a b -> Object a b
anonymise [Bool]
makeAnonymousList [Object className relationshipName]
objects
    }
  where
    anonymise :: Bool -> Object a b -> Object a b
    anonymise :: forall a b. Bool -> Object a b -> Object a b
anonymise Bool
anonymous Object a b
o = Object a b
o {isAnonymous :: Bool
isAnonymous = Bool
anonymous}

canShuffleClassNames :: ObjectDiagram String String linkLabels -> Bool
canShuffleClassNames :: forall linkLabels. ObjectDiagram String String linkLabels -> Bool
canShuffleClassNames ObjectDiagram {[Link String linkLabels]
[Object String String]
objects :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Object objectName className]
links :: forall objectName className linkLabel.
ObjectDiagram objectName className linkLabel
-> [Link objectName linkLabel]
objects :: [Object String String]
links :: [Link String linkLabels]
..} =
  (Object String String -> Bool) -> [Object String String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Object {Bool
String
isAnonymous :: forall objectName className. Object objectName className -> Bool
objectName :: forall objectName className.
Object objectName className -> objectName
objectClass :: forall objectName className.
Object objectName className -> className
isAnonymous :: Bool
objectName :: String
objectClass :: String
..} -> ShowS
lowerFirst String
objectClass String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
objectName) [Object String String]
objects

isObjectDiagramRandomisable
  :: ObjectDiagram String String linkLabels
  -> Maybe String
isObjectDiagramRandomisable :: forall linkLabels.
ObjectDiagram String String linkLabels -> Maybe String
isObjectDiagramRandomisable ObjectDiagram String String linkLabels
od
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ObjectDiagram String String linkLabels -> Bool
forall linkLabels. ObjectDiagram String String linkLabels -> Bool
canShuffleClassNames ObjectDiagram String String linkLabels
od
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
      object names of the CD have to match to their class names
      (e.g., c1 for C or anyOne for AnyOne).
      |]
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing

anyThickEdge :: Cd -> Bool
anyThickEdge :: Cd -> Bool
anyThickEdge = ((Bool, Relationship String String) -> Bool)
-> [(Bool, Relationship String String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, Relationship String String) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, Relationship String String)] -> Bool)
-> (Cd -> [(Bool, Relationship String String)]) -> Cd -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cd -> [(Bool, Relationship String String)]
calculateThickRelationships

calculateThickAnyRelationships
  :: AnyCd
  -> [(Bool, AnyRelationship String String)]
calculateThickAnyRelationships :: AnyCd -> [(Bool, AnyRelationship String String)]
calculateThickAnyRelationships AnyClassDiagram {[String]
[AnyRelationship String String]
anyClassNames :: forall className relationshipName.
AnyClassDiagram className relationshipName -> [className]
anyRelationships :: forall className relationshipName.
AnyClassDiagram className relationshipName
-> [AnyRelationship className relationshipName]
anyClassNames :: [String]
anyRelationships :: [AnyRelationship String String]
..} =
  (AnyRelationship String String
 -> Maybe (Relationship String String))
-> [String]
-> [AnyRelationship String String]
-> [(Bool, AnyRelationship String String)]
forall relationship.
(relationship -> Maybe (Relationship String String))
-> [String] -> [relationship] -> [(Bool, relationship)]
calculateThickRelationshipsHelper
  AnyRelationship String String -> Maybe (Relationship String String)
forall {a} {a}. Either a a -> Maybe a
toRelationship
  [String]
anyClassNames
  [AnyRelationship String String]
anyRelationships
  where
    toRelationship :: Either a a -> Maybe a
toRelationship = (a -> Maybe a) -> (a -> Maybe a) -> Either a a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just

calculateThickRelationships :: Cd -> [(Bool, Relationship String String)]
calculateThickRelationships :: Cd -> [(Bool, Relationship String String)]
calculateThickRelationships ClassDiagram {[String]
[Relationship String String]
classNames :: forall className relationshipName.
ClassDiagram className relationshipName -> [className]
relationships :: forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
classNames :: [String]
relationships :: [Relationship String String]
..} =
  (Relationship String String -> Maybe (Relationship String String))
-> [String]
-> [Relationship String String]
-> [(Bool, Relationship String String)]
forall relationship.
(relationship -> Maybe (Relationship String String))
-> [String] -> [relationship] -> [(Bool, relationship)]
calculateThickRelationshipsHelper
  Relationship String String -> Maybe (Relationship String String)
forall a. a -> Maybe a
Just
  [String]
classNames
  [Relationship String String]
relationships

calculateThickRelationshipsHelper
  :: (relationship -> Maybe (Relationship String String))
  -> [String]
  -> [relationship]
  -> [(Bool, relationship)]
calculateThickRelationshipsHelper :: forall relationship.
(relationship -> Maybe (Relationship String String))
-> [String] -> [relationship] -> [(Bool, relationship)]
calculateThickRelationshipsHelper relationship -> Maybe (Relationship String String)
toRelationship [String]
allClassNames [relationship]
allRelationships =
  (relationship -> (Bool, relationship))
-> [relationship] -> [(Bool, relationship)]
forall a b. (a -> b) -> [a] -> [b]
map ((relationship -> Bool)
-> (relationship, relationship) -> (Bool, relationship)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Maybe (Relationship String String) -> Bool
forall {relationshipName}.
Maybe (Relationship String relationshipName) -> Bool
isThick (Maybe (Relationship String String) -> Bool)
-> (relationship -> Maybe (Relationship String String))
-> relationship
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. relationship -> Maybe (Relationship String String)
toRelationship) ((relationship, relationship) -> (Bool, relationship))
-> (relationship -> (relationship, relationship))
-> relationship
-> (Bool, relationship)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. relationship -> (relationship, relationship)
forall a. a -> (a, a)
dupe) [relationship]
allRelationships
  where
    classesWithSubclasses :: [(String, [String])]
classesWithSubclasses = (String -> (String, [String])) -> [String] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\String
name -> (String
name, [String] -> String -> [String]
subs [] String
name)) [String]
allClassNames
      where
        subs :: [String] -> String -> [String]
subs [String]
seen String
name
          | String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
seen = []
          | Bool
otherwise = String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Relationship String String -> [String])
-> [Relationship String String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
              ([String] -> String -> [String]
subs (String
nameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
seen) (String -> [String])
-> (Relationship String String -> String)
-> Relationship String String
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationship String String -> String
forall className relationshipName.
Relationship className relationshipName -> className
subClass)
              ((Relationship String String -> Bool)
-> [Relationship String String] -> [Relationship String String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> (Relationship String String -> String)
-> Relationship String String
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationship String String -> String
forall className relationshipName.
Relationship className relationshipName -> className
superClass) [Relationship String String]
inheritances)
    relevantRelationships :: [Relationship String String]
relevantRelationships = (relationship -> Maybe (Relationship String String))
-> [relationship] -> [Relationship String String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe relationship -> Maybe (Relationship String String)
toRelationship [relationship]
allRelationships
    inheritances :: [Relationship String String]
inheritances = (Relationship String String -> Bool)
-> [Relationship String String] -> [Relationship String String]
forall a. (a -> Bool) -> [a] -> [a]
filter
      (\case Inheritance {} -> Bool
True; Relationship String String
_ -> Bool
False)
      [Relationship String String]
relevantRelationships
    nonInheritancesBothWays :: [(String, String)]
nonInheritancesBothWays = (Relationship String String -> [(String, String)])
-> [Relationship String String] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      (((LimitedLinking String, LimitedLinking String)
 -> (String, String))
-> [(LimitedLinking String, LimitedLinking String)]
-> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((LimitedLinking String -> String)
-> (LimitedLinking String, LimitedLinking String)
-> (String, String)
forall a b. (a -> b) -> (a, a) -> (b, b)
both LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking) ([(LimitedLinking String, LimitedLinking String)]
 -> [(String, String)])
-> (Relationship String String
    -> [(LimitedLinking String, LimitedLinking String)])
-> Relationship String String
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationship String String
-> [(LimitedLinking String, LimitedLinking String)]
forall {className} {relationshipName}.
Relationship className relationshipName
-> [(LimitedLinking className, LimitedLinking className)]
nonInheritanceBothWays)
      [Relationship String String]
relevantRelationships
    isThick :: Maybe (Relationship String relationshipName) -> Bool
isThick Maybe (Relationship String relationshipName)
Nothing = Bool
False
    isThick (Just Relationship String relationshipName
x) = Relationship String relationshipName -> Bool
forall {relationshipName}.
Relationship String relationshipName -> Bool
isNonInheritanceThick Relationship String relationshipName
x
    isNonInheritanceThick :: Relationship String relationshipName -> Bool
isNonInheritanceThick Relationship String relationshipName
r = case Relationship String relationshipName
r of
      Inheritance {} -> Bool
False
      Association {relationshipName
LimitedLinking String
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: relationshipName
associationFrom :: LimitedLinking String
associationTo :: LimitedLinking String
..} -> String
-> String -> [(String, [String])] -> [(String, String)] -> Bool
shouldBeThick
        (LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
associationFrom)
        (LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
associationTo)
        [(String, [String])]
classesWithSubclasses
        [(String, String)]
nonInheritancesBothWays
      Aggregation {relationshipName
LimitedLinking String
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: relationshipName
aggregationPart :: LimitedLinking String
aggregationWhole :: LimitedLinking String
..} -> String
-> String -> [(String, [String])] -> [(String, String)] -> Bool
shouldBeThick
        (LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
aggregationWhole)
        (LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
aggregationPart)
        [(String, [String])]
classesWithSubclasses
        [(String, String)]
nonInheritancesBothWays
      Composition {relationshipName
LimitedLinking String
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: relationshipName
compositionPart :: LimitedLinking String
compositionWhole :: LimitedLinking String
..} -> String
-> String -> [(String, [String])] -> [(String, String)] -> Bool
shouldBeThick
        (LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
compositionWhole)
        (LimitedLinking String -> String
forall nodeName. LimitedLinking nodeName -> nodeName
linking LimitedLinking String
compositionPart)
        [(String, [String])]
classesWithSubclasses
        [(String, String)]
nonInheritancesBothWays
    nonInheritanceBothWays :: Relationship className relationshipName
-> [(LimitedLinking className, LimitedLinking className)]
nonInheritanceBothWays Inheritance {} = []
    nonInheritanceBothWays Association {relationshipName
LimitedLinking className
associationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
associationFrom :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationTo :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
associationName :: relationshipName
associationFrom :: LimitedLinking className
associationTo :: LimitedLinking className
..} =
      [(LimitedLinking className
associationFrom, LimitedLinking className
associationTo), (LimitedLinking className
associationTo, LimitedLinking className
associationFrom)]
    nonInheritanceBothWays Aggregation {relationshipName
LimitedLinking className
aggregationName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
aggregationPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
aggregationName :: relationshipName
aggregationPart :: LimitedLinking className
aggregationWhole :: LimitedLinking className
..} =
      [(LimitedLinking className
aggregationPart, LimitedLinking className
aggregationWhole), (LimitedLinking className
aggregationWhole, LimitedLinking className
aggregationPart)]
    nonInheritanceBothWays Composition {relationshipName
LimitedLinking className
compositionName :: forall className relationshipName.
Relationship className relationshipName -> relationshipName
compositionPart :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionWhole :: forall className relationshipName.
Relationship className relationshipName -> LimitedLinking className
compositionName :: relationshipName
compositionPart :: LimitedLinking className
compositionWhole :: LimitedLinking className
..} =
      [(LimitedLinking className
compositionPart, LimitedLinking className
compositionWhole), (LimitedLinking className
compositionWhole, LimitedLinking className
compositionPart)]

shouldBeThick
  :: String
  -> String
  -> [(String, [String])]
  -> [(String, String)]
  -> Bool
shouldBeThick :: String
-> String -> [(String, [String])] -> [(String, String)] -> Bool
shouldBeThick String
a String
b [(String, [String])]
classesWithSubclasses =
  ((String, String) -> Bool) -> [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(String
a',String
b') ->
         (String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
a' Bool -> Bool -> Bool
|| String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
b')
         Bool -> Bool -> Bool
&& let { one :: Bool
one = String
a' String -> String -> Bool
`isSubOf` String
a; two :: Bool
two = String
b' String -> String -> Bool
`isSubOf` String
b }
            in (Bool
one Bool -> Bool -> Bool
&& (Bool
two Bool -> Bool -> Bool
|| String
b String -> String -> Bool
`isSubOf` String
b') Bool -> Bool -> Bool
|| Bool
two Bool -> Bool -> Bool
&& (Bool
one Bool -> Bool -> Bool
|| String
a String -> String -> Bool
`isSubOf` String
a'))
      )
  where String
x isSubOf :: String -> String -> Bool
`isSubOf` String
y = String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Maybe [String] -> [String]
forall a. HasCallStack => Maybe a -> a
fromJust (String -> [(String, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
y [(String, [String])]
classesWithSubclasses)

{-|
When indefinite articles can not be avoided completely
-}
data ArticlePreference
  = UseDefiniteArticleWherePossible
  -- ^ prefer definite articles
  | UseIndefiniteArticleEverywhere
  -- ^ always use indefinite articles
  deriving (ArticlePreference -> ArticlePreference -> Bool
(ArticlePreference -> ArticlePreference -> Bool)
-> (ArticlePreference -> ArticlePreference -> Bool)
-> Eq ArticlePreference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArticlePreference -> ArticlePreference -> Bool
== :: ArticlePreference -> ArticlePreference -> Bool
$c/= :: ArticlePreference -> ArticlePreference -> Bool
/= :: ArticlePreference -> ArticlePreference -> Bool
Eq, (forall x. ArticlePreference -> Rep ArticlePreference x)
-> (forall x. Rep ArticlePreference x -> ArticlePreference)
-> Generic ArticlePreference
forall x. Rep ArticlePreference x -> ArticlePreference
forall x. ArticlePreference -> Rep ArticlePreference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArticlePreference -> Rep ArticlePreference x
from :: forall x. ArticlePreference -> Rep ArticlePreference x
$cto :: forall x. Rep ArticlePreference x -> ArticlePreference
to :: forall x. Rep ArticlePreference x -> ArticlePreference
Generic, ReadPrec [ArticlePreference]
ReadPrec ArticlePreference
Int -> ReadS ArticlePreference
ReadS [ArticlePreference]
(Int -> ReadS ArticlePreference)
-> ReadS [ArticlePreference]
-> ReadPrec ArticlePreference
-> ReadPrec [ArticlePreference]
-> Read ArticlePreference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ArticlePreference
readsPrec :: Int -> ReadS ArticlePreference
$creadList :: ReadS [ArticlePreference]
readList :: ReadS [ArticlePreference]
$creadPrec :: ReadPrec ArticlePreference
readPrec :: ReadPrec ArticlePreference
$creadListPrec :: ReadPrec [ArticlePreference]
readListPrec :: ReadPrec [ArticlePreference]
Read, Int -> ArticlePreference -> ShowS
[ArticlePreference] -> ShowS
ArticlePreference -> String
(Int -> ArticlePreference -> ShowS)
-> (ArticlePreference -> String)
-> ([ArticlePreference] -> ShowS)
-> Show ArticlePreference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArticlePreference -> ShowS
showsPrec :: Int -> ArticlePreference -> ShowS
$cshow :: ArticlePreference -> String
show :: ArticlePreference -> String
$cshowList :: [ArticlePreference] -> ShowS
showList :: [ArticlePreference] -> ShowS
Show)

{-|
Convert 'ArticlePreference' directly to 'ArticleToUse' (without conditions).
-}
toArticleToUse :: ArticlePreference -> ArticleToUse
toArticleToUse :: ArticlePreference -> ArticleToUse
toArticleToUse = \case
  ArticlePreference
UseDefiniteArticleWherePossible -> ArticleToUse
DefiniteArticle
  ArticlePreference
UseIndefiniteArticleEverywhere -> ArticleToUse
IndefiniteArticle

{-|
How to phrase non inheritance relationships
-}
data NonInheritancePhrasing
  = ByDirection
  -- ^ refer in some way to start and end
  | ByName
  -- ^ refer to the name
  | Lengthy
  -- ^ Associations are phrased lengthy, others as 'ByDirection'

{-|
Choose 'NonInheritancePhrasing' according to parameters in this order
 * by name (first parameter)
 * by direction (second parameter)
 * otherwise lengthy
-}
toPhrasing :: Bool -> Bool -> NonInheritancePhrasing
toPhrasing :: Bool -> Bool -> NonInheritancePhrasing
toPhrasing Bool
byName Bool
withDir
  | Bool
byName = NonInheritancePhrasing
ByName
  | Bool
withDir = NonInheritancePhrasing
ByDirection
  | Bool
otherwise = NonInheritancePhrasing
Lengthy

{-|
For choosing a specific phrasing variation.
-}
data PhrasingKind
  = Denoted
  -- ^ refer to denoted multiplicities
  | Participations
  -- ^ describe how often objects can participate