{-|
Module      :  Database.Persist.Migration.Operation.Types
Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
Stability   :  experimental
Portability :  portable

Defines auxiliary data types that can be used in Operations.
-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Database.Persist.Migration.Operation.Types
  ( ColumnIdentifier
  , dotted
  , Column(..)
  , validateColumn
  , ColumnProp(..)
  , TableConstraint(..)
  , isPrimaryKey
  , getConstraintColumns
  ) where

import Control.Monad (when)
import Data.List (nub)
import Data.Text (Text)
import qualified Data.Text as Text
import Database.Persist.Sql (PersistValue(..))
import Database.Persist.Types (SqlType)

-- | A column identifier, table.column
type ColumnIdentifier = (Text, Text)

-- | Make a ColumnIdentifier displayable.
dotted :: ColumnIdentifier -> Text
dotted :: ColumnIdentifier -> Text
dotted (Text
tab, Text
col) = [Text] -> Text
Text.concat [Text
tab, Text
".", Text
col]

-- | The definition for a Column in a SQL database.
data Column = Column
  { Column -> Text
colName  :: Text
  , Column -> SqlType
colType  :: SqlType
  , Column -> [ColumnProp]
colProps :: [ColumnProp]
  } deriving (Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show)

-- | Validate a Column.
validateColumn :: Column -> Either String ()
validateColumn :: Column -> Either String ()
validateColumn col :: Column
col@Column{[ColumnProp]
Text
SqlType
colProps :: [ColumnProp]
colType :: SqlType
colName :: Text
$sel:colProps:Column :: Column -> [ColumnProp]
$sel:colType:Column :: Column -> SqlType
$sel:colName:Column :: Column -> Text
..} = Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall a. Eq a => [a] -> Bool
hasDuplicates ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnProp -> String) -> [ColumnProp] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ColumnProp -> String
getColumnPropName [ColumnProp]
colProps) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
  String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"Duplicate column properties detected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Column -> String
forall a. Show a => a -> String
show Column
col
  where
    hasDuplicates :: [a] -> Bool
hasDuplicates [a]
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
l)

    getColumnPropName :: ColumnProp -> String
    getColumnPropName :: ColumnProp -> String
getColumnPropName = \case
      NotNull{} -> String
"NotNull"
      References{} -> String
"References"
      AutoIncrement{} -> String
"AutoIncrement"
      Default{} -> String
"Default"

-- | A property for a 'Column'.
data ColumnProp
  = NotNull
    -- ^ Makes a column non-nullable (defaults to nullable)
  | References ColumnIdentifier
    -- ^ Mark this column as a foreign key to the given column
  | AutoIncrement
    -- ^ Makes a column auto-incrementing
  | Default PersistValue
    -- ^ Sets the default value for the column. Note that this doesn't matter when inserting
    -- data via Haskell; this property only sets the schema in the SQL backend.
    --
    -- See 'AddColumn' for setting the default value for existing rows in a migration.
    --
    -- More info: https://www.yesodweb.com/book/persistent#persistent_attributes
  deriving (Int -> ColumnProp -> ShowS
[ColumnProp] -> ShowS
ColumnProp -> String
(Int -> ColumnProp -> ShowS)
-> (ColumnProp -> String)
-> ([ColumnProp] -> ShowS)
-> Show ColumnProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnProp] -> ShowS
$cshowList :: [ColumnProp] -> ShowS
show :: ColumnProp -> String
$cshow :: ColumnProp -> String
showsPrec :: Int -> ColumnProp -> ShowS
$cshowsPrec :: Int -> ColumnProp -> ShowS
Show,ColumnProp -> ColumnProp -> Bool
(ColumnProp -> ColumnProp -> Bool)
-> (ColumnProp -> ColumnProp -> Bool) -> Eq ColumnProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnProp -> ColumnProp -> Bool
$c/= :: ColumnProp -> ColumnProp -> Bool
== :: ColumnProp -> ColumnProp -> Bool
$c== :: ColumnProp -> ColumnProp -> Bool
Eq)

-- | Table constraints in a CREATE query.
data TableConstraint
  = PrimaryKey [Text] -- ^ PRIMARY KEY (col1, col2, ...)
  | Unique Text [Text] -- ^ CONSTRAINT name UNIQUE (col1, col2, ...)
  deriving (Int -> TableConstraint -> ShowS
[TableConstraint] -> ShowS
TableConstraint -> String
(Int -> TableConstraint -> ShowS)
-> (TableConstraint -> String)
-> ([TableConstraint] -> ShowS)
-> Show TableConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableConstraint] -> ShowS
$cshowList :: [TableConstraint] -> ShowS
show :: TableConstraint -> String
$cshow :: TableConstraint -> String
showsPrec :: Int -> TableConstraint -> ShowS
$cshowsPrec :: Int -> TableConstraint -> ShowS
Show)

isPrimaryKey :: TableConstraint -> Bool
isPrimaryKey :: TableConstraint -> Bool
isPrimaryKey = \case
  PrimaryKey{} -> Bool
True
  TableConstraint
_ -> Bool
False

-- | Get the columns defined in the given TableConstraint.
getConstraintColumns :: TableConstraint -> [Text]
getConstraintColumns :: TableConstraint -> [Text]
getConstraintColumns = \case
  PrimaryKey [Text]
cols -> [Text]
cols
  Unique Text
_ [Text]
cols -> [Text]
cols