Refactors to move validation logic to its own namespace
parent
6e1341b52a
commit
041d55f9dd
|
@ -1,4 +1,8 @@
|
||||||
module Ringo where
|
module Ringo
|
||||||
|
( module Ringo.Types
|
||||||
|
, module Ringo.Extractor
|
||||||
|
, module Ringo.Generator
|
||||||
|
) where
|
||||||
|
|
||||||
import Ringo.Types
|
import Ringo.Types
|
||||||
import Ringo.Extractor
|
import Ringo.Extractor
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
module Ringo.Extractor
|
module Ringo.Extractor
|
||||||
( validateTable
|
( extractDimensions
|
||||||
, validateFact
|
|
||||||
, extractDimensions
|
|
||||||
, extractFactTable
|
, extractFactTable
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -13,58 +11,12 @@ import Data.Monoid ((<>))
|
||||||
|
|
||||||
import Ringo.Extractor.Internal
|
import Ringo.Extractor.Internal
|
||||||
import Ringo.Types
|
import Ringo.Types
|
||||||
|
import Ringo.Utils
|
||||||
|
|
||||||
validateTable :: Table -> Reader ExtractorEnv [ValidationError]
|
extractFactTable :: Fact -> Table -> Reader Env Table
|
||||||
validateTable table = do
|
extractFactTable fact table = do
|
||||||
tables <- asks eeTables
|
Settings {..} <- asks envSettings
|
||||||
return . concatMap (checkConstraint tables) . tableConstraints $ table
|
allDims <- extractAllDimensions fact table
|
||||||
where
|
|
||||||
checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName
|
|
||||||
checkConstraint _ (UniqueKey columnNames) = checkTableForColRefs table columnNames
|
|
||||||
checkConstraint tables (ForeignKey oTableName columnNames) =
|
|
||||||
case findTable oTableName tables of
|
|
||||||
Just oTable -> checkTableForColRefs table (map fst columnNames)
|
|
||||||
++ checkTableForColRefs oTable (map snd columnNames)
|
|
||||||
Nothing -> [ MissingTable oTableName ]
|
|
||||||
|
|
||||||
checkTableForColRefs tab = concatMap (checkTableForCol tab)
|
|
||||||
|
|
||||||
validateFact :: Fact -> Reader ExtractorEnv [ValidationError]
|
|
||||||
validateFact Fact {..} = do
|
|
||||||
tables <- asks eeTables
|
|
||||||
case findTable factTableName tables of
|
|
||||||
Nothing -> return [ MissingTable factTableName ]
|
|
||||||
Just table -> do
|
|
||||||
tableVs <- validateTable table
|
|
||||||
parentVs <- concat <$> mapM checkFactParents factParentNames
|
|
||||||
let colVs = concatMap (checkColumn table) factColumns
|
|
||||||
return $ tableVs ++ parentVs ++ colVs
|
|
||||||
where
|
|
||||||
checkFactParents fName = do
|
|
||||||
facts <- asks eeFacts
|
|
||||||
case findFact fName facts of
|
|
||||||
Nothing -> return [ MissingFact fName ]
|
|
||||||
Just pFact -> validateFact pFact
|
|
||||||
|
|
||||||
checkColumn table = maybe [] (checkTableForCol table) . factColumnName
|
|
||||||
|
|
||||||
withFactValidation :: Fact -> (Table -> Reader ExtractorEnv a)
|
|
||||||
-> Reader ExtractorEnv (Either [ValidationError] a)
|
|
||||||
withFactValidation fact func = do
|
|
||||||
tables <- asks eeTables
|
|
||||||
errors <- validateFact fact
|
|
||||||
if not $ null errors
|
|
||||||
then return $ Left errors
|
|
||||||
else fmap Right . func . fromJust . findTable (factTableName fact) $ tables
|
|
||||||
|
|
||||||
extractDimensions :: Fact -> Reader ExtractorEnv (Either [ValidationError] [Table])
|
|
||||||
extractDimensions fact = withFactValidation fact $ extractDimensions' fact
|
|
||||||
|
|
||||||
extractFactTable :: Fact -> Reader ExtractorEnv (Either [ValidationError] Table)
|
|
||||||
extractFactTable fact =
|
|
||||||
withFactValidation fact $ \table -> do
|
|
||||||
Settings {..} <- asks eeSettings
|
|
||||||
allDims <- extractAllDimensions' fact table
|
|
||||||
|
|
||||||
let intType = "integer"
|
let intType = "integer"
|
||||||
sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
|
sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
|
||||||
|
|
|
@ -6,28 +6,15 @@ import qualified Data.Text as Text
|
||||||
import Control.Monad.Reader (Reader, asks)
|
import Control.Monad.Reader (Reader, asks)
|
||||||
import Data.Maybe (mapMaybe, fromMaybe, fromJust)
|
import Data.Maybe (mapMaybe, fromMaybe, fromJust)
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
import Data.List (nub, find)
|
import Data.List (nub)
|
||||||
|
|
||||||
import Ringo.Types
|
import Ringo.Types
|
||||||
|
import Ringo.Utils
|
||||||
|
|
||||||
findTable :: TableName -> [Table] -> Maybe Table
|
extractDimensions :: Fact -> Table -> Reader Env [Table]
|
||||||
findTable tName = find ((== tName) . tableName)
|
extractDimensions fact Table {..} = do
|
||||||
|
tables <- asks envTables
|
||||||
findFact :: TableName -> [Fact] -> Maybe Fact
|
prefix <- settingDimPrefix <$> asks envSettings
|
||||||
findFact fName = find ((== fName) . factName)
|
|
||||||
|
|
||||||
findColumn :: ColumnName -> [Column] -> Maybe Column
|
|
||||||
findColumn cName = find ((== cName) . columnName)
|
|
||||||
|
|
||||||
checkTableForCol :: Table -> ColumnName -> [ValidationError]
|
|
||||||
checkTableForCol tab colName =
|
|
||||||
[ MissingColumn (tableName tab) colName |
|
|
||||||
not . any ((colName ==) . columnName) . tableColumns $ tab ]
|
|
||||||
|
|
||||||
extractDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table]
|
|
||||||
extractDimensions' fact Table {..} = do
|
|
||||||
tables <- asks eeTables
|
|
||||||
prefix <- settingDimPrefix <$> asks eeSettings
|
|
||||||
return $ dimsFromIds tables ++ dimsFromVals prefix
|
return $ dimsFromIds tables ++ dimsFromVals prefix
|
||||||
where
|
where
|
||||||
dimsFromIds tables =
|
dimsFromIds tables =
|
||||||
|
@ -59,15 +46,15 @@ dimColumnName :: Text.Text -> ColumnName -> ColumnName
|
||||||
dimColumnName dimName columnName =
|
dimColumnName dimName columnName =
|
||||||
fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
|
fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
|
||||||
|
|
||||||
extractAllDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table]
|
extractAllDimensions :: Fact -> Table -> Reader Env [Table]
|
||||||
extractAllDimensions' fact table = do
|
extractAllDimensions fact table = do
|
||||||
myDims <- extractDimensions' fact table
|
myDims <- extractDimensions fact table
|
||||||
parentDims <- concat <$> mapM extract (factParentNames fact)
|
parentDims <- concat <$> mapM extract (factParentNames fact)
|
||||||
return . nub $ myDims ++ parentDims
|
return . nub $ myDims ++ parentDims
|
||||||
where
|
where
|
||||||
extract fName = do
|
extract fName = do
|
||||||
tables <- asks eeTables
|
tables <- asks envTables
|
||||||
facts <- asks eeFacts
|
facts <- asks envFacts
|
||||||
let pFact = fromJust . findFact fName $ facts
|
let pFact = fromJust . findFact fName $ facts
|
||||||
pFactTable = fromJust . findTable (factTableName pFact) $ tables
|
pFactTable = fromJust . findTable (factTableName pFact) $ tables
|
||||||
extractAllDimensions' pFact pFactTable
|
extractAllDimensions pFact pFactTable
|
||||||
|
|
|
@ -79,8 +79,8 @@ data ValidationError = MissingTable TableName
|
||||||
| MissingColumn TableName ColumnName
|
| MissingColumn TableName ColumnName
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data ExtractorEnv = ExtractorEnv
|
data Env = Env
|
||||||
{ eeTables :: [Table]
|
{ envTables :: [Table]
|
||||||
, eeFacts :: [Fact]
|
, envFacts :: [Fact]
|
||||||
, eeSettings :: Settings
|
, envSettings :: Settings
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
|
@ -0,0 +1,14 @@
|
||||||
|
module Ringo.Utils where
|
||||||
|
|
||||||
|
import Data.List (find)
|
||||||
|
|
||||||
|
import Ringo.Types
|
||||||
|
|
||||||
|
findTable :: TableName -> [Table] -> Maybe Table
|
||||||
|
findTable tName = find ((== tName) . tableName)
|
||||||
|
|
||||||
|
findFact :: TableName -> [Fact] -> Maybe Fact
|
||||||
|
findFact fName = find ((== fName) . factName)
|
||||||
|
|
||||||
|
findColumn :: ColumnName -> [Column] -> Maybe Column
|
||||||
|
findColumn cName = find ((== cName) . columnName)
|
|
@ -0,0 +1,56 @@
|
||||||
|
module Ringo.Validator where
|
||||||
|
|
||||||
|
import Control.Monad.Reader (Reader, asks)
|
||||||
|
import Data.Maybe (mapMaybe, fromMaybe, fromJust)
|
||||||
|
import Data.Monoid ((<>))
|
||||||
|
|
||||||
|
import Ringo.Types
|
||||||
|
import Ringo.Utils
|
||||||
|
|
||||||
|
checkTableForCol :: Table -> ColumnName -> [ValidationError]
|
||||||
|
checkTableForCol tab colName =
|
||||||
|
[ MissingColumn (tableName tab) colName |
|
||||||
|
not . any ((colName ==) . columnName) . tableColumns $ tab ]
|
||||||
|
|
||||||
|
validateTable :: Table -> Reader Env [ValidationError]
|
||||||
|
validateTable table = do
|
||||||
|
tables <- asks envTables
|
||||||
|
return . concatMap (checkConstraint tables) . tableConstraints $ table
|
||||||
|
where
|
||||||
|
checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName
|
||||||
|
checkConstraint _ (UniqueKey columnNames) = checkTableForColRefs table columnNames
|
||||||
|
checkConstraint tables (ForeignKey oTableName columnNames) =
|
||||||
|
case findTable oTableName tables of
|
||||||
|
Just oTable -> checkTableForColRefs table (map fst columnNames)
|
||||||
|
++ checkTableForColRefs oTable (map snd columnNames)
|
||||||
|
Nothing -> [ MissingTable oTableName ]
|
||||||
|
|
||||||
|
checkTableForColRefs tab = concatMap (checkTableForCol tab)
|
||||||
|
|
||||||
|
validateFact :: Fact -> Reader Env [ValidationError]
|
||||||
|
validateFact Fact {..} = do
|
||||||
|
tables <- asks envTables
|
||||||
|
case findTable factTableName tables of
|
||||||
|
Nothing -> return [ MissingTable factTableName ]
|
||||||
|
Just table -> do
|
||||||
|
tableVs <- validateTable table
|
||||||
|
parentVs <- concat <$> mapM checkFactParents factParentNames
|
||||||
|
let colVs = concatMap (checkColumn table) factColumns
|
||||||
|
return $ tableVs ++ parentVs ++ colVs
|
||||||
|
where
|
||||||
|
checkFactParents fName = do
|
||||||
|
facts <- asks envFacts
|
||||||
|
case findFact fName facts of
|
||||||
|
Nothing -> return [ MissingFact fName ]
|
||||||
|
Just pFact -> validateFact pFact
|
||||||
|
|
||||||
|
checkColumn table = maybe [] (checkTableForCol table) . factColumnName
|
||||||
|
|
||||||
|
withFactValidation :: Fact -> (Table -> Reader Env a)
|
||||||
|
-> Reader Env (Either [ValidationError] a)
|
||||||
|
withFactValidation fact func = do
|
||||||
|
tables <- asks envTables
|
||||||
|
errors <- validateFact fact
|
||||||
|
if not $ null errors
|
||||||
|
then return $ Left errors
|
||||||
|
else fmap Right . func . fromJust . findTable (factTableName fact) $ tables
|
Loading…
Reference in New Issue