-- |
-- Module      : Database.Relational.Table
-- Copyright   : 2013-2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines table type which has table metadatas.
module Database.Relational.Table (
  -- * Phantom typed table type
  Table, untype, name, shortName, width, columns, index, table, toMaybe, recordWidth,

  toSubQuery,

  -- * Table existence inference
  TableDerivable (..)
  ) where

import Data.Array (listArray)

import Database.Record.Persistable
  (PersistableWidth, PersistableRecordWidth, unsafePersistableRecordWidth)

import Database.Relational.Internal.UntypedTable (Untyped (Untyped), name', width', columns', (!))
import Database.Relational.Internal.String (StringSQL, stringSQL, showStringSQL)
import Database.Relational.SqlSyntax (SubQuery)
import qualified Database.Relational.SqlSyntax as Syntax


-- | Phantom typed table type
newtype Table r = Table Untyped

instance Show (Table r) where
  show :: Table r -> String
show Table r
t =
    [String] -> String
unwords
    [String
"Table",  ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Table r -> String
forall r. Table r -> String
name Table r
t,
     [String] -> String
forall a. Show a => a -> String
show ([String] -> String)
-> ([StringSQL] -> [String]) -> [StringSQL] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StringSQL -> String) -> [StringSQL] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map StringSQL -> String
showStringSQL ([StringSQL] -> String) -> [StringSQL] -> String
forall a b. (a -> b) -> a -> b
$ Table r -> [StringSQL]
forall r. Table r -> [StringSQL]
columns Table r
t]

-- | Untype table.
untype :: Table t -> Untyped
untype :: Table t -> Untyped
untype (Table Untyped
u) = Untyped
u

-- | Name string of table in SQL
name :: Table r -> String
name :: Table r -> String
name   = Untyped -> String
name' (Untyped -> String) -> (Table r -> Untyped) -> Table r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> Untyped
forall t. Table t -> Untyped
untype

-- | Not qualified name string of table in SQL
shortName :: Table r -> String
shortName :: Table r -> String
shortName =  ShowS
forall a. [a] -> [a]
tail ShowS -> (Table r -> String) -> Table r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') ShowS -> (Table r -> String) -> Table r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> String
forall r. Table r -> String
name

-- | Width of table
width :: Table r -> Int
width :: Table r -> Int
width  = Untyped -> Int
width' (Untyped -> Int) -> (Table r -> Untyped) -> Table r -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> Untyped
forall t. Table t -> Untyped
untype

-- | Column name strings in SQL
columns :: Table r -> [StringSQL]
columns :: Table r -> [StringSQL]
columns =  Untyped -> [StringSQL]
columns' (Untyped -> [StringSQL])
-> (Table r -> Untyped) -> Table r -> [StringSQL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> Untyped
forall t. Table t -> Untyped
untype

-- | Column name string in SQL specified by index
index :: Table r
      -> Int       -- ^ Column index
      -> StringSQL -- ^ Column name String in SQL
index :: Table r -> Int -> StringSQL
index =  (!) (Untyped -> Int -> StringSQL)
-> (Table r -> Untyped) -> Table r -> Int -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> Untyped
forall t. Table t -> Untyped
untype

-- | Cast phantom type into 'Maybe' type.
toMaybe :: Table r -> Table (Maybe r)
toMaybe :: Table r -> Table (Maybe r)
toMaybe (Table Untyped
t) = Untyped -> Table (Maybe r)
forall r. Untyped -> Table r
Table Untyped
t

-- | Unsafely generate phantom typed table type.
table :: String -> [String] -> Table r
table :: String -> [String] -> Table r
table String
n [String]
f = Untyped -> Table r
forall r. Untyped -> Table r
Table (Untyped -> Table r) -> Untyped -> Table r
forall a b. (a -> b) -> a -> b
$ String -> Int -> Array Int StringSQL -> Untyped
Untyped String
n Int
w Array Int StringSQL
fa  where
  w :: Int
w  = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
f
  fa :: Array Int StringSQL
fa = (Int, Int) -> [StringSQL] -> Array Int StringSQL
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([StringSQL] -> Array Int StringSQL)
-> [StringSQL] -> Array Int StringSQL
forall a b. (a -> b) -> a -> b
$ (String -> StringSQL) -> [String] -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map String -> StringSQL
stringSQL [String]
f

-- | 'SubQuery' from 'Table'.
toSubQuery :: Table r  -- ^ Typed 'Table' metadata
           -> SubQuery -- ^ Result 'SubQuery'
toSubQuery :: Table r -> SubQuery
toSubQuery = Untyped -> SubQuery
Syntax.Table (Untyped -> SubQuery)
-> (Table r -> Untyped) -> Table r -> SubQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> Untyped
forall t. Table t -> Untyped
untype

-- | Inference rule of 'Table' existence.
class PersistableWidth r => TableDerivable r where
  derivedTable :: Table r

-- | PersistableRecordWidth of table
recordWidth :: Table r -> PersistableRecordWidth r
recordWidth :: Table r -> PersistableRecordWidth r
recordWidth = Int -> PersistableRecordWidth r
forall a. Int -> PersistableRecordWidth a
unsafePersistableRecordWidth (Int -> PersistableRecordWidth r)
-> (Table r -> Int) -> Table r -> PersistableRecordWidth r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> Int
forall r. Table r -> Int
width