{-# 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 )
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
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)
]
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
]
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
]
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
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