{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Database.Relational.Record
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines interfaces of projected record type.
module Database.Relational.Record (
  -- * Record data structure and interface
  Record,

  width,
  columns,
  untype,

  unsafeFromSqlTerms,
  unsafeFromQualifiedSubQuery,
  unsafeFromScalarSubQuery,
  unsafeFromTable,

  unsafeStringSql,

  -- * Projections
  pi, piMaybe, piMaybe',
  wpi,

  flattenMaybe, just,

  unsafeToAggregated, unsafeToFlat, unsafeChangeContext,
  unsafeStringSqlNotNullMaybe,

  -- * List of Record
  RecordList, list, unsafeListFromSubQuery,
  unsafeStringSqlList
  ) where

import Prelude hiding (pi)
import Data.Functor.ProductIsomorphic
  (ProductIsoFunctor, (|$|), ProductIsoApplicative, pureP, (|*|),
   ProductIsoEmpty, pureE, peRight, peLeft, )

import qualified Language.SQL.Keyword as SQL

import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint, PersistableWidth, persistableWidth)
import Database.Record.Persistable (PersistableRecordWidth)
import qualified Database.Record.KeyConstraint as KeyConstraint

import Database.Relational.Internal.ContextType (Aggregated, Flat)
import Database.Relational.Internal.String (StringSQL, listStringSQL, rowStringSQL)
import Database.Relational.SqlSyntax
  (SubQuery, Qualified, Tuple, Record,
   recordRawColumns, tupleFromJoinedSubQuery,)
import qualified Database.Relational.SqlSyntax as Syntax

import Database.Relational.Table (Table)
import qualified Database.Relational.Table as Table
import Database.Relational.Pi (Pi)
import qualified Database.Relational.Pi.Unsafe as UnsafePi


-- | Unsafely get SQL term from 'Record'.
unsafeStringSql :: Record c r -> StringSQL
unsafeStringSql :: forall c r. Record c r -> StringSQL
unsafeStringSql = [StringSQL] -> StringSQL
rowStringSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r. Record c r -> [StringSQL]
recordRawColumns

-- | Get column SQL string list of record.
columns :: Record c r  -- ^ Source 'Record'
        -> [StringSQL] -- ^ Result SQL string list
columns :: forall c r. Record c r -> [StringSQL]
columns = forall c r. Record c r -> [StringSQL]
recordRawColumns

-- | Width of 'Record'.
width :: Record c r -> Int
width :: forall c r. Record c r -> Int
width = forall c r. Record c r -> Int
Syntax.recordWidth

-- | Get untyped tuple.
untype :: Record c r -> Tuple
untype :: forall c r. Record c r -> Tuple
untype = forall c r. Record c r -> Tuple
Syntax.untypeRecord


-- | Unsafely generate  'Record' from qualified (joined) sub-query.
unsafeFromQualifiedSubQuery :: Qualified SubQuery -> Record c t
unsafeFromQualifiedSubQuery :: forall c t. Qualified SubQuery -> Record c t
unsafeFromQualifiedSubQuery = forall c t. Tuple -> Record c t
Syntax.record forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified SubQuery -> Tuple
tupleFromJoinedSubQuery

-- | Unsafely generate 'Record' from scalar sub-query.
unsafeFromScalarSubQuery :: SubQuery -> Record c t
unsafeFromScalarSubQuery :: forall c t. SubQuery -> Record c t
unsafeFromScalarSubQuery = forall c t. SubQuery -> Record c t
Syntax.typeFromScalarSubQuery

-- | Unsafely generate unqualified 'Record' from 'Table'.
unsafeFromTable :: Table r
                -> Record c r
unsafeFromTable :: forall r c. Table r -> Record c r
unsafeFromTable = forall c r. [StringSQL] -> Record c r
Syntax.typeFromRawColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Table r -> [StringSQL]
Table.columns

-- | Unsafely generate 'Record' from SQL expression strings.
unsafeFromSqlTerms :: [StringSQL] -> Record c t
unsafeFromSqlTerms :: forall c r. [StringSQL] -> Record c r
unsafeFromSqlTerms = forall c r. [StringSQL] -> Record c r
Syntax.typeFromRawColumns


-- | Unsafely trace projection path.
unsafeProject :: PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject :: forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject PersistableRecordWidth a
w Record c a'
p Pi a b
pi' =
  forall c r. [StringSQL] -> Record c r
Syntax.typeFromRawColumns
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r0 r1 a. PersistableRecordWidth r0 -> Pi r0 r1 -> [a] -> [a]
UnsafePi.pi PersistableRecordWidth a
w Pi a b
pi')
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r. Record c r -> [StringSQL]
columns forall a b. (a -> b) -> a -> b
$ Record c a'
p

-- | Trace projection path to get narrower 'Record'.
wpi :: PersistableRecordWidth a
    -> Record c a -- ^ Source 'Record'
    -> Pi a b     -- ^ Projection path
    -> Record c b -- ^ Narrower 'Record'
wpi :: forall a c b.
PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
wpi =  forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject

-- | Trace projection path to get narrower 'Record'.
pi :: PersistableWidth a
   => Record c a -- ^ Source 'Record'
   -> Pi a b     -- ^ Record path
   -> Record c b -- ^ Narrower 'Record'
pi :: forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
pi =  forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth

-- | Trace projection path to get narrower 'Record'. From 'Maybe' type to 'Maybe' type.
piMaybe :: PersistableWidth a
        => Record c (Maybe a) -- ^ Source 'Record'. 'Maybe' type
        -> Pi a b             -- ^ Projection path
        -> Record c (Maybe b) -- ^ Narrower 'Record'. 'Maybe' type result
piMaybe :: forall a c b.
PersistableWidth a =>
Record c (Maybe a) -> Pi a b -> Record c (Maybe b)
piMaybe = forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth

-- | Trace projection path to get narrower 'Record'. From 'Maybe' type to 'Maybe' type.
--   Leaf type of projection path is 'Maybe'.
piMaybe' :: PersistableWidth a
         => Record c (Maybe a) -- ^ Source 'Record'. 'Maybe' type
         -> Pi a (Maybe b)     -- ^ Projection path. 'Maybe' type leaf
         -> Record c (Maybe b) -- ^ Narrower 'Record'. 'Maybe' type result
piMaybe' :: forall a c b.
PersistableWidth a =>
Record c (Maybe a) -> Pi a (Maybe b) -> Record c (Maybe b)
piMaybe' = forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth

unsafeCast :: Record c r -> Record c r'
unsafeCast :: forall c r r'. Record c r -> Record c r'
unsafeCast = forall c t. Tuple -> Record c t
Syntax.record forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r. Record c r -> Tuple
Syntax.untypeRecord

-- | Composite nested 'Maybe' on record phantom type.
flattenMaybe :: Record c (Maybe (Maybe a)) -> Record c (Maybe a)
flattenMaybe :: forall c a. Record c (Maybe (Maybe a)) -> Record c (Maybe a)
flattenMaybe =  forall c r r'. Record c r -> Record c r'
unsafeCast

-- | Cast into 'Maybe' on record phantom type.
just :: Record c r -> Record c (Maybe r)
just :: forall c r. Record c r -> Record c (Maybe r)
just =  forall c r r'. Record c r -> Record c r'
unsafeCast

-- | Unsafely cast context type tag.
unsafeChangeContext :: Record c r -> Record c' r
unsafeChangeContext :: forall c r c'. Record c r -> Record c' r
unsafeChangeContext = forall c t. Tuple -> Record c t
Syntax.record forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r. Record c r -> Tuple
Syntax.untypeRecord

-- | Unsafely lift to aggregated context.
unsafeToAggregated :: Record Flat r -> Record Aggregated r
unsafeToAggregated :: forall r. Record Flat r -> Record Aggregated r
unsafeToAggregated =  forall c r c'. Record c r -> Record c' r
unsafeChangeContext

-- | Unsafely down to flat context.
unsafeToFlat :: Record Aggregated r -> Record Flat r
unsafeToFlat :: forall r. Record Aggregated r -> Record Flat r
unsafeToFlat =  forall c r c'. Record c r -> Record c' r
unsafeChangeContext

notNullMaybeConstraint :: HasColumnConstraint NotNull r => Record c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint :: forall r c.
HasColumnConstraint NotNull r =>
Record c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint =  forall a b. a -> b -> a
const forall c a. HasColumnConstraint c a => ColumnConstraint c a
KeyConstraint.columnConstraint

-- | Unsafely get SQL string expression of not null key record.
unsafeStringSqlNotNullMaybe :: HasColumnConstraint NotNull r => Record c (Maybe r) -> StringSQL
unsafeStringSqlNotNullMaybe :: forall r c.
HasColumnConstraint NotNull r =>
Record c (Maybe r) -> StringSQL
unsafeStringSqlNotNullMaybe Record c (Maybe r)
p = (forall a. [a] -> Int -> a
!!  forall c r. ColumnConstraint c r -> Int
KeyConstraint.index (forall r c.
HasColumnConstraint NotNull r =>
Record c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint Record c (Maybe r)
p)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r. Record c r -> [StringSQL]
columns forall a b. (a -> b) -> a -> b
$ Record c (Maybe r)
p

pempty :: Record c ()
pempty :: forall c. Record c ()
pempty = forall c t. Tuple -> Record c t
Syntax.record []

-- | Map 'Record' which result type is record.
instance ProductIsoFunctor (Record c) where
  a -> b
_ |$| :: forall a b.
ProductConstructor (a -> b) =>
(a -> b) -> Record c a -> Record c b
|$| Record c a
p = forall c r r'. Record c r -> Record c r'
unsafeCast Record c a
p

-- | Compose 'Record' using applicative style.
instance ProductIsoApplicative (Record c) where
  pureP :: forall a. ProductConstructor a => a -> Record c a
pureP a
_ = forall c r r'. Record c r -> Record c r'
unsafeCast forall c. Record c ()
pempty
  Record c (a -> b)
pf |*| :: forall a b. Record c (a -> b) -> Record c a -> Record c b
|*| Record c a
pa = forall c t. Tuple -> Record c t
Syntax.record forall a b. (a -> b) -> a -> b
$ forall c r. Record c r -> Tuple
Syntax.untypeRecord Record c (a -> b)
pf forall a. [a] -> [a] -> [a]
++ forall c r. Record c r -> Tuple
Syntax.untypeRecord Record c a
pa

instance ProductIsoEmpty (Record c) () where
  pureE :: Record c ()
pureE   = forall (f :: * -> *) a.
(ProductIsoApplicative f, ProductConstructor a) =>
a -> f a
pureP ()
  peRight :: forall a. Record c (a, ()) -> Record c a
peRight = forall c r r'. Record c r -> Record c r'
unsafeCast
  peLeft :: forall a. Record c ((), a) -> Record c a
peLeft  = forall c r r'. Record c r -> Record c r'
unsafeCast

-- | Projected record list type for row list.
data RecordList p t = List [p t]
                    | Sub SubQuery

-- | Make projected record list from 'Record' list.
list :: [p t] -> RecordList p t
list :: forall (p :: * -> *) t. [p t] -> RecordList p t
list =  forall (p :: * -> *) t. [p t] -> RecordList p t
List

-- | Make projected record list from 'SubQuery'.
unsafeListFromSubQuery :: SubQuery -> RecordList p t
unsafeListFromSubQuery :: forall (p :: * -> *) t. SubQuery -> RecordList p t
unsafeListFromSubQuery =  forall (p :: * -> *) t. SubQuery -> RecordList p t
Sub

-- | Map record show operatoions and concatenate to single SQL expression.
unsafeStringSqlList :: (p t -> StringSQL) -> RecordList p t -> StringSQL
unsafeStringSqlList :: forall (p :: * -> *) t.
(p t -> StringSQL) -> RecordList p t -> StringSQL
unsafeStringSqlList p t -> StringSQL
sf = RecordList p t -> StringSQL
d  where
  d :: RecordList p t -> StringSQL
d (List [p t]
ps) = [StringSQL] -> StringSQL
listStringSQL forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map p t -> StringSQL
sf [p t]
ps
  d (Sub SubQuery
sub) = StringSQL -> StringSQL
SQL.paren forall a b. (a -> b) -> a -> b
$ SubQuery -> StringSQL
Syntax.showSQL SubQuery
sub