module Drasil.Database.UIDRef (
  -- * 'UID' References
  UIDRef, hide, unhide, unhideOrErr,
  UnitypedUIDRef, hideUni, unhideUni, unhideUniOrErr
) where

import Control.Lens ((^.))
import Data.Maybe (fromMaybe)

import Drasil.Database.Chunk (IsChunk, HasChunkRefs (..))
import Drasil.Database.ChunkDB (ChunkDB, find)
import Drasil.Database.UID (HasUID(..), UID)
import qualified Data.Set as S (singleton)

-- | A reference to another chunk through its 'UID', with a type variable to
-- retain information about the original chunk's type, useful for type-safe
-- dereferencing.
newtype UIDRef typ = UIDRef UID

instance HasChunkRefs (UIDRef t) where
  -- | A 'UIDRef t' carries a 'UID' referring to a chunk of type 't'.
  chunkRefs :: UIDRef t -> Set UID
chunkRefs (UIDRef UID
u) = UID -> Set UID
forall a. a -> Set a
S.singleton UID
u
  {-# INLINABLE chunkRefs #-}

-- | Create a 'UIDRef' to a chunk.
hide :: IsChunk t => t -> UIDRef t
hide :: forall t. IsChunk t => t -> UIDRef t
hide = UID -> UIDRef t
forall typ. UID -> UIDRef typ
UIDRef (UID -> UIDRef t) -> (t -> UID) -> t -> UIDRef t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Getting UID t UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID t UID
forall c. HasUID c => Getter c UID
Getter t UID
uid)

-- | Find a chunk by a 'UIDRef'.
unhide :: IsChunk t => UIDRef t -> ChunkDB -> Maybe t
unhide :: forall t. IsChunk t => UIDRef t -> ChunkDB -> Maybe t
unhide (UIDRef UID
u) = UID -> ChunkDB -> Maybe t
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
u

-- | Find a chunk by a 'UIDRef', erroring if not found.
unhideOrErr :: IsChunk t => UIDRef t -> ChunkDB -> t
unhideOrErr :: forall t. IsChunk t => UIDRef t -> ChunkDB -> t
unhideOrErr UIDRef t
tu ChunkDB
cdb = t -> Maybe t -> t
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> t
forall a. HasCallStack => [Char] -> a
error [Char]
"Typed UID dereference failed.") (UIDRef t -> ChunkDB -> Maybe t
forall t. IsChunk t => UIDRef t -> ChunkDB -> Maybe t
unhide UIDRef t
tu ChunkDB
cdb)

-- | A variant of 'UIDRef' without type information about the chunk being
-- referred to, effectively treating chunks as being "unityped."
newtype UnitypedUIDRef = UnitypedUIDRef UID

instance HasChunkRefs UnitypedUIDRef where
  -- | A 'UnitypedUIDRef t' carries a 'UID' referring to another chunk.
  chunkRefs :: UnitypedUIDRef -> Set UID
chunkRefs (UnitypedUIDRef UID
u) = UID -> Set UID
forall a. a -> Set a
S.singleton UID
u
  {-# INLINABLE chunkRefs #-}

-- | Create a 'UnitypedUIDRef' to a chunk.
hideUni :: IsChunk t => t -> UnitypedUIDRef
hideUni :: forall t. IsChunk t => t -> UnitypedUIDRef
hideUni = UID -> UnitypedUIDRef
UnitypedUIDRef (UID -> UnitypedUIDRef) -> (t -> UID) -> t -> UnitypedUIDRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Getting UID t UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID t UID
forall c. HasUID c => Getter c UID
Getter t UID
uid)

-- | Find a chunk by its 'UnitypedUIDRef'.
unhideUni :: IsChunk t => UnitypedUIDRef -> ChunkDB -> Maybe t
unhideUni :: forall t. IsChunk t => UnitypedUIDRef -> ChunkDB -> Maybe t
unhideUni (UnitypedUIDRef UID
u) = UID -> ChunkDB -> Maybe t
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
u

-- | Find a chunk by its 'UnitypedUIDRef', erroring if not found.
unhideUniOrErr :: IsChunk t => UnitypedUIDRef -> ChunkDB -> t
unhideUniOrErr :: forall t. IsChunk t => UnitypedUIDRef -> ChunkDB -> t
unhideUniOrErr UnitypedUIDRef
tu ChunkDB
cdb = t -> Maybe t -> t
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> t
forall a. HasCallStack => [Char] -> a
error [Char]
"Untyped UID dereference failed.") (UnitypedUIDRef -> ChunkDB -> Maybe t
forall t. IsChunk t => UnitypedUIDRef -> ChunkDB -> Maybe t
unhideUni UnitypedUIDRef
tu ChunkDB
cdb)