{-# LANGUAGE ExistentialQuantification,
             ConstraintKinds,
             InstanceSigs,
             TypeOperators,
             TypeApplications,
             FlexibleContexts,
             UndecidableInstances,
             FlexibleInstances #-}
module Drasil.Database.Chunk (
  Chunk,
  IsChunk,
  HasChunkRefs(..),
  mkChunk, -- FIXME: mkChunk should not be exported but is temporarily because this module is NOT in `drasil-database`
  unChunk,
  chunkType
) where

import Control.Lens ((^.), to, Getter)
import qualified Data.Set as S
import Data.Typeable (Proxy (Proxy), TypeRep, Typeable, cast, typeOf, typeRep)
import GHC.Generics (Generic (Rep, from), M1 (..), K1 (..), type (:*:) (..),
  type (:+:) (..), U1, Generically(..))

import Drasil.Database.UID (HasUID (..), 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)

instance HasChunkRefs Chunk where
  chunkRefs :: Chunk -> S.Set UID
  chunkRefs :: Chunk -> Set UID
chunkRefs (Chunk a
c) = a -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs a
c

-- | 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

-- | The majority of chunks will relate other chunks in some way. In other
-- words, the majority of our chunks *depend* on others. 'HasChunkRefs' is meant
-- as a way to capture what things a chunk *directly* refers to (i.e., depends
-- on directly).
class HasChunkRefs a where
  chunkRefs :: a -> S.Set UID

instance HasChunkRefs UID where
  -- | 'UID's are meant to be "owned" (i.e., they are the unique identifier of
  -- the chunk being defined), not *carried as references to other chunks*.
  -- 'TypedUIDRef t' exists to be used as a *reference to another chunk of type
  -- 't'*. Therefore, `UID` has no chunk references.
  chunkRefs :: UID -> Set UID
chunkRefs UID
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE chunkRefs #-}

instance HasChunkRefs Int where
  chunkRefs :: Int -> Set UID
chunkRefs Int
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE chunkRefs #-}

instance HasChunkRefs Integer where
  chunkRefs :: Integer -> Set UID
chunkRefs Integer
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE chunkRefs #-}

instance HasChunkRefs Double where
  chunkRefs :: Double -> Set UID
chunkRefs Double
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE chunkRefs #-}

instance HasChunkRefs Bool where
  chunkRefs :: Bool -> Set UID
chunkRefs Bool
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE chunkRefs #-}

instance HasChunkRefs Char where
  chunkRefs :: Char -> Set UID
chunkRefs Char
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE chunkRefs #-}

-- NOTE: 'OVERLAPPING' instance here because [Char] is instantiated with
-- `HasChunkRefs [a]`, but very inefficient. We already know the result will be
-- empty.
instance {-# OVERLAPPING #-} HasChunkRefs String where
  chunkRefs :: [Char] -> Set UID
chunkRefs [Char]
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE chunkRefs #-}

instance HasChunkRefs a => HasChunkRefs [a] where
  chunkRefs :: [a] -> Set UID
chunkRefs = [Set UID] -> Set UID
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set UID] -> Set UID) -> ([a] -> [Set UID]) -> [a] -> Set UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set UID) -> [a] -> [Set UID]
forall a b. (a -> b) -> [a] -> [b]
map a -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs
  {-# INLINABLE chunkRefs #-}

instance HasChunkRefs a => HasChunkRefs (Maybe a) where
  chunkRefs :: Maybe a -> Set UID
chunkRefs Maybe a
Nothing = Set UID
forall a. Set a
S.empty
  chunkRefs (Just a
v) = a -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs a
v
  {-# INLINABLE chunkRefs #-}

instance (HasChunkRefs l, HasChunkRefs r) => HasChunkRefs (Either l r) where
  chunkRefs :: Either l r -> Set UID
chunkRefs = (l -> Set UID) -> (r -> Set UID) -> Either l r -> Set UID
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs r -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs
  {-# INLINABLE chunkRefs #-}

instance (Generic a, GHasCRefs (Rep a)) => HasChunkRefs (Generically a) where
  chunkRefs :: Generically a -> Set UID
chunkRefs (Generically a
a) = Rep a Any -> Set UID
forall p. Rep a p -> Set UID
forall (f :: * -> *) p. GHasCRefs f => f p -> Set UID
gChunkRefs (Rep a Any -> Set UID) -> Rep a Any -> Set UID
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a
  {-# INLINABLE chunkRefs #-}

class GHasCRefs f where
  gChunkRefs :: f p -> S.Set UID

-- Meta-information (constructors, selectors): pass through
instance GHasCRefs f => GHasCRefs (M1 i c f) where
  gChunkRefs :: forall p. M1 i c f p -> Set UID
gChunkRefs (M1 f p
x) = f p -> Set UID
forall p. f p -> Set UID
forall (f :: * -> *) p. GHasCRefs f => f p -> Set UID
gChunkRefs f p
x
  {-# INLINABLE gChunkRefs #-}

-- Products: Union
instance (GHasCRefs a, GHasCRefs b) => GHasCRefs (a :*: b) where
  gChunkRefs :: forall p. (:*:) a b p -> Set UID
gChunkRefs (a p
a :*: b p
b) = a p -> Set UID
forall p. a p -> Set UID
forall (f :: * -> *) p. GHasCRefs f => f p -> Set UID
gChunkRefs a p
a Set UID -> Set UID -> Set UID
forall a. Ord a => Set a -> Set a -> Set a
`S.union` b p -> Set UID
forall p. b p -> Set UID
forall (f :: * -> *) p. GHasCRefs f => f p -> Set UID
gChunkRefs b p
b
  {-# INLINABLE gChunkRefs #-}

-- Sums: Depends on variant
instance (GHasCRefs a, GHasCRefs b) => GHasCRefs (a :+: b) where
  gChunkRefs :: forall p. (:+:) a b p -> Set UID
gChunkRefs (L1 a p
x) = a p -> Set UID
forall p. a p -> Set UID
forall (f :: * -> *) p. GHasCRefs f => f p -> Set UID
gChunkRefs a p
x
  gChunkRefs (R1 b p
x) = b p -> Set UID
forall p. b p -> Set UID
forall (f :: * -> *) p. GHasCRefs f => f p -> Set UID
gChunkRefs b p
x
  {-# INLINABLE gChunkRefs #-}

-- Fields: Delegate
instance HasChunkRefs c => GHasCRefs (K1 i c) where
  gChunkRefs :: forall p. K1 i c p -> Set UID
gChunkRefs (K1 c
x) = c -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs c
x
  {-# INLINABLE gChunkRefs #-}

-- Unit: Nothing!
instance GHasCRefs U1 where
  gChunkRefs :: forall p. U1 p -> Set UID
gChunkRefs U1 p
_ = Set UID
forall a. Set a
S.empty
  {-# INLINABLE gChunkRefs #-}