content: {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  
  -- |
  -- Module      : Database.Relational.Constraint
  -- Copyright   : 2013-2017 Kei Hibino
  -- License     : BSD3
  --
  -- Maintainer  : ex8k.hibino@gmail.com
  -- Stability   : experimental
  -- Portability : unknown
  --
  -- This module provides proof object definitions of constraint key.
  -- Difference between this module and "Database.Record.KeyConstraint" is
  -- typed constraint key column definition is included in this module.
  module Database.Relational.Constraint (
    -- * Constraint Key proof object
    Key, indexes, unsafeDefineConstraintKey,
    tableConstraint, projectionKey,
  
    -- unsafeReturnKey, -- unsafeAppendConstraint,
  
    -- * Derivation rules
    uniqueKey, -- notNullKey,
  
    -- * Inference rules
    HasConstraintKey (..),
    derivedUniqueKey, -- derivedNotNullKey,
  
    -- * Constraint types
    Primary, Unique, NotNull
    ) where
  
  
  import Database.Record (PersistableRecordWidth, PersistableWidth (persistableWidth))
  import Database.Record.KeyConstraint
    (KeyConstraint, unsafeSpecifyKeyConstraint,
     Primary, Unique, NotNull)
  import qualified Database.Record.KeyConstraint as C
  
  import Database.Relational.Pi (Pi)
  import qualified Database.Relational.Pi.Unsafe as UnsafePi
  
  
  -- | Constraint Key proof object. Constraint type 'c', record type 'r' and columns type 'ct'.
  data Key c r ct = Key [Int] (PersistableRecordWidth ct)
  
  -- | Index of key which specifies constraint key.
  indexes :: Key c r ct -> [Int]
  indexes (Key is _) = is
  
  -- | Width of key.
  width :: Key c r ct -> PersistableRecordWidth ct
  width (Key _ w) = w
  
  -- | Unsafely generate constraint 'Key' proof object using specified key index.
  unsafeDefineConstraintKey :: PersistableWidth ct
                            => [Int]      -- ^ Key indexes which specify this constraint key
                            -> Key c r ct -- ^ Result constraint key proof object
  unsafeDefineConstraintKey ixs = Key ixs persistableWidth
  
  -- | Get table constraint 'KeyConstraint' proof object from constraint 'Key'.
  tableConstraint :: Key c r ct -> KeyConstraint c r
  tableConstraint =  unsafeSpecifyKeyConstraint . indexes
  
  -- | Get projection path proof object from constraint 'Key'.
  projectionKey :: Key c r ct -> Pi r ct
  projectionKey k =  UnsafePi.defineDirectPi' w ixs  where
    ixs = indexes k
    w   = width k
  
  -- | Unsafe. Make constraint key to add column phantom type
  unsafeReturnKey :: PersistableWidth ct
                  => KeyConstraint c r -> Key c r ct
  unsafeReturnKey =  unsafeDefineConstraintKey . C.indexes
  
  -- -- | Unsafe. Make constraint key to add constraint phantom type
  -- unsafeAppendConstraint :: Pi r ct -> Key c r ct
  -- unsafeAppendConstraint =  unsafeDefineConstraintKey . leafIndex
  
  
  -- | Map from table constraint into constraint 'Key'.
  mapConstraint :: PersistableWidth ct
                => (KeyConstraint c0 r -> KeyConstraint c1 r)
                -> Key c0 r ct
                -> Key c1 r ct
  mapConstraint f = unsafeReturnKey . f . tableConstraint
  
  -- | Derive 'Unique' constraint 'Key' from 'Primary' constraint 'Key'
  uniqueKey :: PersistableWidth ct
            => Key Primary r ct -> Key Unique r ct
  uniqueKey  = mapConstraint C.unique
  
  -- -- | Derive 'NotNull' constraint 'Key' from 'Primary' constraint 'Key'
  -- notNullKey :: Key Primary r ct -> Key NotNull r ct
  -- notNullKey =  mapConstraint C.notNull
  
  
  -- | Constraint 'Key' inference interface.
  class PersistableWidth ct => HasConstraintKey c r ct  where
    -- | Infer constraint key.
    constraintKey :: Key c r ct
  
  -- | Inferred 'Unique' constraint 'Key'.
  --   Record type 'r' has unique key which type is 'ct' derived from primary key.
  derivedUniqueKey :: HasConstraintKey Primary r ct => Key Unique r ct
  derivedUniqueKey =  uniqueKey constraintKey
  
  -- -- | Inferred 'NotNull' constraint 'Key'.
  -- --   Record type 'r' has not-null key which type is 'ct' derived from primary key.
  -- derivedNotNullKey :: HasConstraintKey Primary r ct => Key NotNull r ct
  -- derivedNotNullKey =  notNullKey constraintKey
  