{-# LANGUAGE OverloadedStrings, CPP #-}
module Database.Selda.Table.Validation where
import Control.Exception ( Exception, throw )
import Data.List (group, sort)
import Data.Text (Text, any, intercalate, unpack)
import Data.Typeable ( Typeable )
import Database.Selda.Table.Type
    ( ColAttr(Required, Optional),
      ColInfo(colFKs, colName, colAttrs),
      Table(Table),
      isPrimary,
      isUnique )
import Database.Selda.Types
    ( TableName, fromColName, fromTableName )

-- | An error occurred when validating a database table.
--   If this error is thrown, there is a bug in your database schema, and the
--   particular table that triggered the error is unusable.
--   Since validation is deterministic, this error will be thrown on every
--   consecutive operation over the offending table.
--
--   Therefore, it is not meaningful to handle this exception in any way,
--   just fix your bug instead.
data ValidationError = ValidationError String
  deriving (Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ValidationError] -> ShowS
$cshowList :: [ValidationError] -> ShowS
show :: ValidationError -> [Char]
$cshow :: ValidationError -> [Char]
showsPrec :: Int -> ValidationError -> ShowS
$cshowsPrec :: Int -> ValidationError -> ShowS
Show, ValidationError -> ValidationError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c== :: ValidationError -> ValidationError -> Bool
Eq, Typeable)
instance Exception ValidationError

-- | Ensure that there are no duplicate column names or primary keys.
--   Returns a list of validation errors encountered.
validate :: TableName -> [ColInfo] -> [Text]
validate :: TableName -> [ColInfo] -> [Text]
validate TableName
name [ColInfo]
cis = [Text]
errs
  where
    colIdents :: [Text]
colIdents = forall a b. (a -> b) -> [a] -> [b]
map (ColName -> Text
fromColName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColInfo -> ColName
colName) [ColInfo]
cis
    allIdents :: [Text]
allIdents = TableName -> Text
fromTableName TableName
name forall a. a -> [a] -> [a]
: [Text]
colIdents
    errs :: [Text]
errs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [Text]
dupes
      , [Text]
pkDupes
      , [Text]
optionalRequiredMutex
      , [Text]
nulIdents
      , [Text]
emptyIdents
      , [Text]
emptyTableName
      , [Text]
nonPkFks
      ]
    emptyTableName :: [Text]
emptyTableName
      | TableName -> Text
fromTableName TableName
name forall a. Eq a => a -> a -> Bool
== Text
"\"\"" = [Text
"table name is empty"]
      | Bool
otherwise                    = []
    emptyIdents :: [Text]
emptyIdents
      | Text
"\"\"" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
colIdents =
        [Text
"table has columns with empty names"]
      | Bool
otherwise =
        []
    nulIdents :: [Text]
nulIdents =
      [ Text
"table or column name contains \\NUL: " forall a. Semigroup a => a -> a -> a
<> Text
n
      | Text
n <- [Text]
allIdents
      , (Char -> Bool) -> Text -> Bool
Data.Text.any (forall a. Eq a => a -> a -> Bool
== Char
'\NUL') Text
n
      ]
    dupes :: [Text]
dupes =
      [Text
"duplicate column: " forall a. Semigroup a => a -> a -> a
<> ColName -> Text
fromColName ColName
x | (ColName
x:ColName
_:[ColName]
_) <- forall a. Ord a => [a] -> [[a]]
soup forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ColInfo -> ColName
colName [ColInfo]
cis]
    pkDupes :: [Text]
pkDupes =
      [Text
"multiple primary keys" | forall {a}. [a] -> Bool
moreThanOne [ColAttr]
pkAttrs]
    nonPkFks :: [Text]
nonPkFks =
      [ Text
"column is used as a foreign key, but is not primary or unique: "
          forall a. Semigroup a => a -> a -> a
<> TableName -> Text
fromTableName TableName
ftn forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> ColName -> Text
fromColName ColName
fcn
      | ColInfo
ci <- [ColInfo]
cis
      , (Table TableName
ftn [ColInfo]
fcs Bool
_ [([Int], ColAttr)]
_, ColName
fcn) <- ColInfo -> [(Table (), ColName)]
colFKs ColInfo
ci
      , ColInfo
fc <- [ColInfo]
fcs
      , ColInfo -> ColName
colName ColInfo
fc forall a. Eq a => a -> a -> Bool
== ColName
fcn
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Prelude.any ColAttr -> Bool
isUnique (ColInfo -> [ColAttr]
colAttrs ColInfo
fc)
      ]

    -- This should be impossible, but...
    optionalRequiredMutex :: [Text]
optionalRequiredMutex =
      [ Text
"BUG: column " forall a. Semigroup a => a -> a -> a
<> ColName -> Text
fromColName (ColInfo -> ColName
colName ColInfo
ci)
                       forall a. Semigroup a => a -> a -> a
<> Text
" is both optional and required"
      | ColInfo
ci <- [ColInfo]
cis
      , ColAttr
Optional forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ColInfo -> [ColAttr]
colAttrs ColInfo
ci Bool -> Bool -> Bool
&& ColAttr
Required forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ColInfo -> [ColAttr]
colAttrs ColInfo
ci
      ]

    moreThanOne :: [a] -> Bool
moreThanOne []  = Bool
False
    moreThanOne [a
_] = Bool
False
    moreThanOne [a]
_   = Bool
True
    pkAttrs :: [ColAttr]
pkAttrs =
      [ ColAttr
attr
      | ColAttr
attr <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ColInfo -> [ColAttr]
colAttrs [ColInfo]
cis
      , ColAttr -> Bool
isPrimary ColAttr
attr
      ]

-- | Return all columns of the given table if the table schema is valid,
--   otherwise throw a 'ValidationError'.
validateOrThrow :: TableName -> [ColInfo] -> [ColInfo]
validateOrThrow :: TableName -> [ColInfo] -> [ColInfo]
validateOrThrow TableName
name [ColInfo]
cols =
  case TableName -> [ColInfo] -> [Text]
validate TableName
name [ColInfo]
cols of
    []     -> [ColInfo]
cols
    [Text]
errors -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Char] -> ValidationError
ValidationError forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [Char]
"validation of table `", Text -> [Char]
unpack forall a b. (a -> b) -> a -> b
$ TableName -> Text
fromTableName TableName
name
      , [Char]
"' failed:\n  "
      , Text -> [Char]
unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate Text
"\n  " [Text]
errors
      ]

-- | Sort a list and remove all duplicates from it.
snub :: (Ord a, Eq a) => [a] -> [a]
snub :: forall a. (Ord a, Eq a) => [a] -> [a]
snub = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [[a]]
soup

-- | Sort a list, then group all identical elements.
soup :: Ord a => [a] -> [[a]]
soup :: forall a. Ord a => [a] -> [[a]]
soup = forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort