{-# 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 :: Record c r -> StringSQL
unsafeStringSql = [StringSQL] -> StringSQL
rowStringSQL ([StringSQL] -> StringSQL)
-> (Record c r -> [StringSQL]) -> Record c r -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c r -> [StringSQL]
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 :: Record c r -> [StringSQL]
columns = Record c r -> [StringSQL]
forall c r. Record c r -> [StringSQL]
recordRawColumns

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

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


-- | Unsafely generate  'Record' from qualified (joined) sub-query.
unsafeFromQualifiedSubQuery :: Qualified SubQuery -> Record c t
unsafeFromQualifiedSubQuery :: Qualified SubQuery -> Record c t
unsafeFromQualifiedSubQuery = Tuple -> Record c t
forall c t. Tuple -> Record c t
Syntax.record (Tuple -> Record c t)
-> (Qualified SubQuery -> Tuple)
-> Qualified SubQuery
-> Record c t
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 :: SubQuery -> Record c t
unsafeFromScalarSubQuery = SubQuery -> Record c t
forall c t. SubQuery -> Record c t
Syntax.typeFromScalarSubQuery

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

-- | Unsafely generate 'Record' from SQL expression strings.
unsafeFromSqlTerms :: [StringSQL] -> Record c t
unsafeFromSqlTerms :: [StringSQL] -> Record c t
unsafeFromSqlTerms = [StringSQL] -> Record c t
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 :: PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject PersistableRecordWidth a
w Record c a'
p Pi a b
pi' =
  [StringSQL] -> Record c b'
forall c r. [StringSQL] -> Record c r
Syntax.typeFromRawColumns
  ([StringSQL] -> Record c b')
-> (Record c a' -> [StringSQL]) -> Record c a' -> Record c b'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PersistableRecordWidth a -> Pi a b -> [StringSQL] -> [StringSQL]
forall r0 r1 a. PersistableRecordWidth r0 -> Pi r0 r1 -> [a] -> [a]
UnsafePi.pi PersistableRecordWidth a
w Pi a b
pi')
  ([StringSQL] -> [StringSQL])
-> (Record c a' -> [StringSQL]) -> Record c a' -> [StringSQL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c a' -> [StringSQL]
forall c r. Record c r -> [StringSQL]
columns (Record c a' -> Record c b') -> Record c a' -> Record c b'
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 :: PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
wpi =  PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
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 :: Record c a -> Pi a b -> Record c b
pi =  PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject PersistableRecordWidth a
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 :: Record c (Maybe a) -> Pi a b -> Record c (Maybe b)
piMaybe = PersistableRecordWidth a
-> Record c (Maybe a) -> Pi a b -> Record c (Maybe b)
forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject PersistableRecordWidth a
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' :: Record c (Maybe a) -> Pi a (Maybe b) -> Record c (Maybe b)
piMaybe' = PersistableRecordWidth a
-> Record c (Maybe a) -> Pi a (Maybe b) -> Record c (Maybe b)
forall a c a' b b'.
PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject PersistableRecordWidth a
forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth

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

-- | Composite nested 'Maybe' on record phantom type.
flattenMaybe :: Record c (Maybe (Maybe a)) -> Record c (Maybe a)
flattenMaybe :: Record c (Maybe (Maybe a)) -> Record c (Maybe a)
flattenMaybe =  Record c (Maybe (Maybe a)) -> Record c (Maybe a)
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 :: Record c r -> Record c (Maybe r)
just =  Record c r -> Record c (Maybe r)
forall c r r'. Record c r -> Record c r'
unsafeCast

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

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

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

notNullMaybeConstraint :: HasColumnConstraint NotNull r => Record c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint :: Record c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint =  NotNullColumnConstraint r
-> Record c (Maybe r) -> NotNullColumnConstraint r
forall a b. a -> b -> a
const NotNullColumnConstraint r
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 :: Record c (Maybe r) -> StringSQL
unsafeStringSqlNotNullMaybe Record c (Maybe r)
p = ([StringSQL] -> Int -> StringSQL
forall a. [a] -> Int -> a
!!  ColumnConstraint NotNull r -> Int
forall c r. ColumnConstraint c r -> Int
KeyConstraint.index (Record c (Maybe r) -> ColumnConstraint NotNull r
forall r c.
HasColumnConstraint NotNull r =>
Record c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint Record c (Maybe r)
p)) ([StringSQL] -> StringSQL)
-> (Record c (Maybe r) -> [StringSQL])
-> Record c (Maybe r)
-> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c (Maybe r) -> [StringSQL]
forall c r. Record c r -> [StringSQL]
columns (Record c (Maybe r) -> StringSQL)
-> Record c (Maybe r) -> StringSQL
forall a b. (a -> b) -> a -> b
$ Record c (Maybe r)
p

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

-- | Map 'Record' which result type is record.
instance ProductIsoFunctor (Record c) where
  a -> b
_ |$| :: (a -> b) -> Record c a -> Record c b
|$| Record c a
p = Record c a -> Record c b
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 :: a -> Record c a
pureP a
_ = Record c () -> Record c a
forall c r r'. Record c r -> Record c r'
unsafeCast Record c ()
forall c. Record c ()
pempty
  Record c (a -> b)
pf |*| :: Record c (a -> b) -> Record c a -> Record c b
|*| Record c a
pa = Tuple -> Record c b
forall c t. Tuple -> Record c t
Syntax.record (Tuple -> Record c b) -> Tuple -> Record c b
forall a b. (a -> b) -> a -> b
$ Record c (a -> b) -> Tuple
forall c t. Record c t -> Tuple
Syntax.untypeRecord Record c (a -> b)
pf Tuple -> Tuple -> Tuple
forall a. [a] -> [a] -> [a]
++ Record c a -> Tuple
forall c t. Record c t -> Tuple
Syntax.untypeRecord Record c a
pa

instance ProductIsoEmpty (Record c) () where
  pureE :: Record c ()
pureE   = () -> Record c ()
forall (f :: * -> *) a.
(ProductIsoApplicative f, ProductConstructor a) =>
a -> f a
pureP ()
  peRight :: Record c (a, ()) -> Record c a
peRight = Record c (a, ()) -> Record c a
forall c r r'. Record c r -> Record c r'
unsafeCast
  peLeft :: Record c ((), a) -> Record c a
peLeft  = Record c ((), a) -> Record c a
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 :: [p t] -> RecordList p t
list =  [p t] -> RecordList p t
forall (p :: * -> *) t. [p t] -> RecordList p t
List

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

-- | Map record show operatoions and concatinate to single SQL expression.
unsafeStringSqlList :: (p t -> StringSQL) -> RecordList p t -> StringSQL
unsafeStringSqlList :: (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 ([StringSQL] -> StringSQL) -> [StringSQL] -> StringSQL
forall a b. (a -> b) -> a -> b
$ (p t -> StringSQL) -> [p t] -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map p t -> StringSQL
sf [p t]
ps
  d (Sub SubQuery
sub) = StringSQL -> StringSQL
SQL.paren (StringSQL -> StringSQL) -> StringSQL -> StringSQL
forall a b. (a -> b) -> a -> b
$ SubQuery -> StringSQL
Syntax.showSQL SubQuery
sub