{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-}

module Drasil.Database.Chunk
  ( Chunk,
    IsChunk,
    HasChunkRefs (..),
    mkChunk,
    unChunk,
    chunkType,
  )
where

import Control.Lens ((^.), to, Getter)
import Data.Typeable (Proxy (Proxy), TypeRep, Typeable, cast, typeOf, typeRep)
import qualified Data.Set as S

import Drasil.Database.UID (HasUID (..), UID)

-- | All chunks should expose what chunks they reference/rely on, so that we can
-- test 'ChunkDB's to ensure all presupposed chunks are already registered.
class HasChunkRefs a where
  chunkRefs :: a -> S.Set UID

-- | Constraint for anything that may be considered a valid chunk type.
type IsChunk a = (HasUID a, HasChunkRefs a, Typeable a)

-- | A piece of reusable knowledge, with an internal identifier ('UID'),
-- possibly dependant on other chunks.
data Chunk = forall a. IsChunk a => Chunk a

instance Eq Chunk where
  (==) :: Chunk -> Chunk -> Bool
  Chunk
l == :: Chunk -> Chunk -> Bool
== Chunk
r = Chunk
l Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk
r Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid

instance HasUID Chunk where
  uid :: Getter Chunk UID
  uid :: Getter Chunk UID
uid = (Chunk -> UID) -> (UID -> f UID) -> Chunk -> f Chunk
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(Chunk a
c) -> a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid)

-- | Create a 'Chunk', ensuring that 'Chunk's are never placed within 'Chunk's.
mkChunk :: IsChunk a => a -> Chunk
mkChunk :: forall a. IsChunk a => a -> Chunk
mkChunk a
a
  | a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
a TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy Chunk -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Chunk) = [Char] -> Chunk
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot place a Chunk inside of a Chunk"
  | Bool
otherwise = a -> Chunk
forall a. IsChunk a => a -> Chunk
Chunk a
a

-- | "Open" chunks, casting them to a specific type.
unChunk :: Typeable a => Chunk -> Maybe a
unChunk :: forall a. Typeable a => Chunk -> Maybe a
unChunk (Chunk a
c) = a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
c

-- | Ask a 'Chunk' for the type of data it codifies.
chunkType :: Chunk -> TypeRep
chunkType :: Chunk -> TypeRep
chunkType (Chunk a
c) = a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
c