{-# LANGUAGE KindSignatures, GADTs, TypeOperators #-}
module Data.HMemDb.Specs
    (
     ColSpec,
     FullSpec(FullSpec, keySpec, tabSpec),
     Keys(Keys),
     KeySpec(KeySpec),
     TableSpec(TableSpec),
     key,
     makeRC,
     nonunique,
     val,
     unique,
     (:+:)((:+:))) where
import Control.Applicative (Applicative(pure, (<*>)), (<$>))
import Control.Compose (Id)
import Data.Binary (Binary)
import Data.Set (Set)
import Data.HMemDb.Bin
    (Proxy(Proxy, unProxy), TableGetData(TableGetData), TableRefs(TRProxy, TRVar))
import Data.HMemDb.ForeignKeys (ForeignKey, getCRef, keyTarget)
import Data.HMemDb.RefConverter (PreRefConv(PreRefConv, rcFrom, rcTo), RefConv(RefConv))
import Data.HMemDb.References (deCRef)
import Data.HMemDb.Tables (Table(Table), tabContent, tabConv)
-- | This is the internal of the 'TableSpec' type.
data ColSpec input output where
    CSEnd :: output -> ColSpec input output
    CSVal ::
        Binary col => (input -> col)
        -> ColSpec input (col -> output)
        -> ColSpec input output
    CSKey ::
        Ord i => (input -> i)
        -> ForeignKey Id i col
        -> ColSpec input (col -> output)
        -> ColSpec input output
instance Functor (ColSpec input) where
    fmap h (CSEnd output) = CSEnd $ h output
    fmap h (CSVal g c) = CSVal g $ (h .) <$> c
    fmap h (CSKey g f c) = CSKey g f $ (h .) <$> c
instance Applicative (ColSpec input) where
    pure = CSEnd
    CSEnd h <*> c = h <$> c
    CSVal g c <*> c' = CSVal g $ flip <$> c <*> c'
    CSKey g f c <*> c' = CSKey g f $ flip <$> c <*> c'
val :: Binary col => (input -> col) -> ColSpec input col
-- ^ This function specifies one column in the table.
-- It instructs the library to store one part of the value.
val h = CSVal h $ pure id
key :: Ord i => ForeignKey Id i col -> (input -> i) -> ColSpec input col
-- ^ This function specifies one column in the table. Unlike 'val', it doesn't
-- store some part of the value; instead it stores the reference to some other table.
key k h = CSKey h k $ pure id
newtype TableSpec a = TableSpec (ColSpec a a)
-- ^ This type represents the table structure. It can be generated using the
-- 'Applicative' interface of the 'ColSpec' like this:
--
-- > data MyData = {myField1 :: Integer, myField2 :: String}
-- > tabSpec = TableSpec (MyData <$> val myField1 <*> val myField2)
--
makeRC :: ColSpec input output -> RefConv input output
makeRC (CSEnd output) = pure output
makeRC (CSVal g c) =
    makeRC c <*>
    RefConv TRProxy (PreRefConv {rcFrom = return . Proxy . g, rcTo = return . unProxy})
makeRC (CSKey g f c) =
    case keyTarget f of
      Table pt ->
          let tgd = TableGetData (rcTo $ tabConv pt) (tabContent pt)
          in makeRC c <*>
             RefConv (TRVar $ tgd) (PreRefConv {rcFrom = getCRef f . g, rcTo = deCRef})
data KeySpec (s :: * -> *) i a = KeySpec (a -> i)
-- ^ This is the specification of one 'ForeignKey'. It could be unique or non-unique.
unique :: (a -> i) -> KeySpec Id i a
-- ^ This function specifies a unique key.
unique = KeySpec
nonunique :: (a -> i) -> KeySpec Set i a
-- ^ This function specifies a non-unique key.
nonunique = KeySpec
data Keys a (h :: (* -> *) -> * -> * -> *) = Keys
-- ^ This type represents an empty set of 'KeySpec's or 'ForeignKey's.
data (u :+: ks) a h where (:+:) :: u a h -> h s i a -> (u :+: KeySpec s i) a h
-- ^ This type operator adds one more 'KeySpec' to the set,
-- or allows to get a 'ForeignKey' back with pattern-matching. Use it like this:
--
-- > do (table, ... :+: foreignKey)
-- >      <- createTable $ FullSpec {..., keySpec = ... :+: unique myKey}
--
infixl 4 :+:
data FullSpec a u = FullSpec {tabSpec :: TableSpec a, keySpec :: u a KeySpec}
-- ^ This is the full specification, of both table and set of keys,
-- which should be fed to 'Data.HMemDb.createTable' and 'Data.HMemDb.getTable' functions.