Adds validation and dimension extraction functions.
parent
048b19d4d2
commit
9107b7c83d
67
src/Ringo.hs
67
src/Ringo.hs
|
@ -1,4 +1,69 @@
|
||||||
module Ringo where
|
module Ringo where
|
||||||
|
|
||||||
import Ringo.Types
|
import Ringo.Types
|
||||||
import Ringo.Tables
|
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import Data.Maybe (mapMaybe, fromMaybe)
|
||||||
|
import Data.List (nub)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
data ValidationError = MissingTable TableName
|
||||||
|
| MissingColumn TableName ColumnName
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
indexList :: Ord k => (a -> k) -> [a] -> Map.Map k a
|
||||||
|
indexList f = Map.fromList . map (\x -> (f x, x))
|
||||||
|
|
||||||
|
checkTableForCol :: Table -> ColumnName -> [ValidationError]
|
||||||
|
checkTableForCol tab colName =
|
||||||
|
[MissingColumn (tableName tab) colName |
|
||||||
|
not . any ((colName ==) . columnName) . tableColumns $ tab]
|
||||||
|
|
||||||
|
validateTable :: [Table] -> Table -> [ValidationError]
|
||||||
|
validateTable tables table = concatMap checkConstraint . tableConstraints $ table
|
||||||
|
where
|
||||||
|
tableMap = indexList tableName tables
|
||||||
|
|
||||||
|
checkConstraint (PrimaryKey colName) = checkTableForCol table colName
|
||||||
|
checkConstraint (UniqueKey columnNames) = checkTableForColRefs table columnNames
|
||||||
|
checkConstraint (ForeignKey oTableName columnNames) =
|
||||||
|
case Map.lookup oTableName tableMap of
|
||||||
|
Just oTable ->
|
||||||
|
checkTableForColRefs table (map fst columnNames)
|
||||||
|
++ checkTableForColRefs oTable (map snd columnNames)
|
||||||
|
Nothing -> [MissingTable oTableName]
|
||||||
|
|
||||||
|
checkTableForColRefs tab = concatMap (checkTableForCol tab)
|
||||||
|
|
||||||
|
validateFact :: [Table] -> Fact -> [ValidationError]
|
||||||
|
validateFact tables Fact {..} =
|
||||||
|
case Map.lookup factTableName tableMap of
|
||||||
|
Nothing -> [MissingTable factTableName]
|
||||||
|
Just table -> concatMap (checkColumn table) factColumns
|
||||||
|
where
|
||||||
|
tableMap = indexList tableName tables
|
||||||
|
|
||||||
|
checkColumn table = checkTableForCol table . factColumnName
|
||||||
|
|
||||||
|
extractDimensions :: T.Text -> Table -> Fact -> [Table]
|
||||||
|
extractDimensions prefix Table {..} Fact {..} =
|
||||||
|
map (\(dim, cols) -> Table { tableName = T.concat [prefix, dim]
|
||||||
|
, tableColumns = Column "id" "serial" NotNullable : cols
|
||||||
|
, tableConstraints = [ PrimaryKey "id"
|
||||||
|
, UniqueKey (map columnName cols)
|
||||||
|
]
|
||||||
|
})
|
||||||
|
. Map.toList
|
||||||
|
. Map.mapWithKey (\dim -> map (cleanColumn dim) . nub)
|
||||||
|
. Map.fromListWith (++)
|
||||||
|
. mapMaybe (\fcol -> do
|
||||||
|
DimVal d col <- fcol
|
||||||
|
column <- Map.lookup col columnMap
|
||||||
|
return (d, [column]))
|
||||||
|
. map Just
|
||||||
|
$ factColumns
|
||||||
|
where
|
||||||
|
columnMap = indexList columnName tableColumns
|
||||||
|
|
||||||
|
cleanColumn dim col@Column {..} =
|
||||||
|
col { columnName = fromMaybe columnName . T.stripPrefix (T.snoc dim '_') $ columnName }
|
||||||
|
|
|
@ -9,43 +9,42 @@ type ColumnName = Text
|
||||||
type ColumnType = Text
|
type ColumnType = Text
|
||||||
type TableName = Text
|
type TableName = Text
|
||||||
|
|
||||||
|
data Nullable = Nullable | NotNullable deriving (Eq, Enum, Show)
|
||||||
|
|
||||||
data Column = Column
|
data Column = Column
|
||||||
{ columnName :: ColumnName
|
{ columnName :: ColumnName
|
||||||
, columnType :: ColumnType
|
, columnType :: ColumnType
|
||||||
, columnNullable :: Bool
|
, columnNullable :: Nullable
|
||||||
, columnDefault :: Maybe Text
|
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
data ColumnRef = ColumnRef ColumnName deriving (Eq, Show)
|
data TableContraint = PrimaryKey ColumnName
|
||||||
|
| UniqueKey [ColumnName]
|
||||||
data TableContraint = PrimaryKey ColumnRef
|
| ForeignKey TableName [(ColumnName, ColumnName)]
|
||||||
| UniqueKey [ColumnRef]
|
|
||||||
| ForeignKey TableRef [(ColumnRef, ColumnRef)]
|
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data Table = Table
|
data Table = Table
|
||||||
{ tableName :: TableName
|
{ tableName :: TableName
|
||||||
, tableColumns :: [Column]
|
, tableColumns :: [Column]
|
||||||
, tableConstraints :: [TableContraint]
|
, tableConstraints :: [TableContraint]
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
data TableRef = TableRef TableName deriving (Eq, Show)
|
data TimeUnit = Second | Minute | Hour | Day | Week | Month | Year
|
||||||
|
deriving (Eq, Enum, Show)
|
||||||
|
|
||||||
column :: ColumnName -> ColumnType -> Column
|
data Fact = Fact
|
||||||
column cname ctype = Column cname ctype True Nothing
|
{ factName :: TableName
|
||||||
|
, factTableName :: TableName
|
||||||
|
, factColumns :: [FactColumn]
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
colNotNull :: Column -> Column
|
data FactColumn = DimTime ColumnName
|
||||||
colNotNull c = c { columnNullable = False }
|
| NoDimId ColumnName
|
||||||
|
| DimId TableName ColumnName
|
||||||
|
| DimVal TableName ColumnName
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
colDefault :: Text -> Column -> Column
|
factColumnName :: FactColumn -> ColumnName
|
||||||
colDefault cdefault c = c { columnDefault = Just cdefault }
|
factColumnName (DimTime cName) = cName
|
||||||
|
factColumnName (NoDimId cName) = cName
|
||||||
primaryKey :: ColumnName -> TableContraint
|
factColumnName (DimId _ cName) = cName
|
||||||
primaryKey = PrimaryKey . ColumnRef
|
factColumnName (DimVal _ cName) = cName
|
||||||
|
|
||||||
uniqueKey :: [ColumnName] -> TableContraint
|
|
||||||
uniqueKey = UniqueKey . map ColumnRef
|
|
||||||
|
|
||||||
foreignKey :: TableName -> [(ColumnName, ColumnName)] -> TableContraint
|
|
||||||
foreignKey tableName =
|
|
||||||
ForeignKey (TableRef tableName) . map (\(c1, c2) -> (ColumnRef c1, ColumnRef c2))
|
|
||||||
|
|
Loading…
Reference in New Issue