module Sqel.Sql.Type where

import qualified Exon

import qualified Sqel.Data.PgType as PgTable
import Sqel.Data.PgType (
  ColumnType (ColumnComp, ColumnPrim),
  PgColumn (PgColumn),
  PgColumnName (PgColumnName),
  PgColumns (PgColumns),
  PgComposite (PgComposite),
  PgPrimName (PgPrimName),
  PgTable (PgTable),
  PgTypeRef (PgTypeRef),
  )
import Sqel.Data.PgTypeName (PgTableName)
import Sqel.Data.Sql (Sql, sql)
import Sqel.Data.SqlFragment (CommaSep (CommaSep))
import Sqel.Text.Quote (dquote)

-- TODO why is unique not used?
columnSpec ::
  PgColumn ->
  Sql
columnSpec :: PgColumn -> Sql
columnSpec = \case
  PgColumn (PgColumnName Text
name) (ColumnPrim (PgPrimName Text
tpe) Bool
_ (forall a (t :: * -> *). (Monoid a, Foldable t) => a -> t a -> a
Exon.intercalate Sql
" " -> Sql
params)) ->
    [sql|##{dquote name} ##{tpe} #{params}|]
  PgColumn (PgColumnName Text
name) (ColumnComp (PgTypeRef Text
tpe) Bool
_ (forall a (t :: * -> *). (Monoid a, Foldable t) => a -> t a -> a
Exon.intercalate Sql
" " -> Sql
params)) ->
    [sql|##{dquote name} ##{tpe} #{params}|]

typeColumnSpec ::
  PgColumn ->
  Sql
typeColumnSpec :: PgColumn -> Sql
typeColumnSpec = \case
  PgColumn (PgColumnName Text
name) (ColumnPrim (PgPrimName Text
tpe) Bool
_ [Sql]
_) ->
    [sql|##{dquote name} ##{tpe}|]
  PgColumn (PgColumnName Text
name) (ColumnComp (PgTypeRef Text
tpe) Bool
_ [Sql]
_) ->
    [sql|##{dquote name} ##{tpe}|]

createTable ::
  PgTable a ->
  Sql
createTable :: forall {k} (a :: k). PgTable a -> Sql
createTable PgTable {PgTableName
$sel:name:PgTable :: forall {k} (a :: k). PgTable a -> PgTableName
name :: PgTableName
name, $sel:columns:PgTable :: forall {k} (a :: k). PgTable a -> PgColumns
columns = PgColumns [PgColumn]
cols} =
  [sql|create table ##{name} (##{CommaSep formattedColumns})|]
  where
    formattedColumns :: [Sql]
formattedColumns = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PgColumn -> Sql
columnSpec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PgColumn]
cols)

dropTable ::
  PgTableName ->
  Sql
dropTable :: PgTableName -> Sql
dropTable PgTableName
name =
   [sql|drop table if exists ##{name}|]

-- TODO make PgTypeRef et al quote automatically by using @ToSegment@
createProdType ::
  PgComposite ->
  Sql
createProdType :: PgComposite -> Sql
createProdType (PgComposite PgCompName
name (PgColumns [PgColumn]
cols)) =
  [sql|create type ##{name} as (##{CommaSep formattedColumns})|]
  where
    formattedColumns :: [Sql]
formattedColumns = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PgColumn -> Sql
typeColumnSpec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PgColumn]
cols)