{-# Language TemplateHaskell #-}
-- | References that have extra information.
module Language.Drasil.DecoratedReference (
  -- * Type
  DecRef(..),
  -- * Class
  HasDecRef(..),
  -- * Constructors
  dRef, dRefInfo
) where

import Language.Drasil.Sentence (RefInfo(..))
import Language.Drasil.Reference (Reference, ref)
import Language.Drasil.Label.Type (HasRefAddress(..))
import Language.Drasil.ShortName (HasShortName(..))
import Language.Drasil.UID (HasUID(..))
import Control.Lens ((^.), makeLenses, Lens')

-- | For holding a 'Reference' that is decorated with extra information (ex. page numbers, equation sources, etc.).
data DecRef = DR {
  DecRef -> Reference
_rf     :: Reference,
  DecRef -> RefInfo
refInfo :: RefInfo
}
makeLenses ''DecRef

-- | A class that contains a list of decorated references ('DecRef's).
class HasDecRef c where
  -- | Provides a 'Lens' to the 'DecRef's.
  getDecRefs :: Lens' c [DecRef]

-- | Equal if 'UID's are equal.
instance Eq            DecRef where DecRef
a == :: DecRef -> DecRef -> Bool
== DecRef
b = (DecRef
a forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (DecRef
b forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
-- | Finds the 'UID' of a 'Reference'.
instance HasUID        DecRef where uid :: Lens' DecRef UID
uid = Lens' DecRef Reference
rf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
-- | Finds the reference address contained in a 'Reference' (through a 'LblType').
instance HasRefAddress DecRef where getRefAdd :: DecRef -> LblType
getRefAdd (DR Reference
r RefInfo
_) = forall b. HasRefAddress b => b -> LblType
getRefAdd Reference
r
-- | Finds the shortname of the reference address used for the 'Reference'.
instance HasShortName  DecRef where shortname :: DecRef -> ShortName
shortname (DR Reference
r RefInfo
_) = forall s. HasShortName s => s -> ShortName
shortname Reference
r

-- | For creating a decorated reference ('DecRef') with extra reference information ('RefInfo').
dRefInfo :: (HasUID r, HasRefAddress r, HasShortName r) => r -> RefInfo -> DecRef
dRefInfo :: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> RefInfo -> DecRef
dRefInfo r
r = Reference -> RefInfo -> DecRef
DR (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref r
r)

-- | Same as 'ref', but for 'DecRef' instead of 'Reference'.
dRef :: (HasUID r, HasRefAddress r, HasShortName r) => r -> DecRef
dRef :: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef r
r = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> RefInfo -> DecRef
dRefInfo r
r RefInfo
None