Adds a smart constructor for Env for better type safety.

- Env is now created through a smart constructor which does
  validations.
pull/1/head
Abhinav Sarkar 2016-02-05 16:17:57 +05:30
parent b58e022b0e
commit ade5c388d8
13 changed files with 439 additions and 379 deletions

View File

@ -1,5 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.ByteString.Lazy as BS
@ -8,7 +10,6 @@ import qualified Data.Text as Text
import Data.Aeson (encode)
import Data.Char (toLower)
import Data.List (nub)
import Control.Monad (forM_)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>), (<.>))
@ -27,14 +28,12 @@ main = do
case result of
Left err -> putStrLn err >> exitFailure
Right (tables, facts, defaults) -> do
let env = Env tables facts progSettings defaults
let errors = nub $ concatMap (validateTable env) tables ++ concatMap (validateFact env) facts
if not $ null errors
then mapM_ print errors >> exitFailure
else writeFiles progOutputDir env >> exitSuccess
case makeEnv tables facts progSettings defaults of
Left errors -> mapM_ print errors >> exitFailure
Right env -> writeFiles progOutputDir env >> exitSuccess
writeFiles :: FilePath -> Env -> IO ()
writeFiles outputDir env@Env{..} = do
writeFiles outputDir env@(envView -> EnvV{..}) = do
let Settings{..} = envSettings
forM_ sqls $ \(sqlType, table, sql) -> do
let dirName = outputDir </> map toLower (show sqlType)

View File

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
module Ringo.InputParser (parseInput) where
import qualified Data.Text as Text
@ -85,5 +86,5 @@ parseInput :: FilePath -> IO (Either String ([Table], [Fact], TypeDefaults))
parseInput file = do
result <- decodeFileEither file
return $ case result of
Left pe -> Left $ prettyPrintParseException pe
Left pe -> Left $ prettyPrintParseException pe
Right (Input tables facts defaults) -> Right (tables, facts, defaults)

View File

@ -26,6 +26,7 @@ library
Ringo.Generator.Create,
Ringo.Generator.Populate.Dimension,
Ringo.Generator.Populate.Fact,
Ringo.Types.Internal,
Ringo.Utils
build-depends: base >=4.7 && <5,
text >=1.2 && <1.3,

View File

@ -12,8 +12,7 @@ module Ringo
, factTableDefnSQL
, dimensionTablePopulateSQL
, factTablePopulateSQL
, validateTable
, validateFact
, makeEnv
) where
import Control.Monad.Reader (runReader)
@ -135,9 +134,14 @@ import qualified Ringo.Validator as V
-- , ("text", "'__UNKNOWN_VAL__'")
-- ]
-- settings = defSettings { settingTableNameSuffixTemplate = "" }
-- env = Env tables facts settings typeDefaults
-- env = case makeEnv tables facts settings typeDefaults of
-- Left errors -> error . unlines . map show $ errors
-- Right env -> env
-- :}
makeEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env
makeEnv = V.validateEnv
-- |
--
-- >>> print $ extractFactTable env sessionFact
@ -615,17 +619,3 @@ dimensionTablePopulateSQL popMode env fact =
factTablePopulateSQL :: TablePopulationMode -> Env -> Fact -> [Text]
factTablePopulateSQL popMode env =
flip runReader env . G.factTablePopulateSQL popMode
-- |
--
-- >>> concatMap (validateTable env) tables
-- []
validateTable :: Env -> Table -> [ValidationError]
validateTable env = flip runReader env . V.validateTable
-- |
--
-- >>> concatMap (validateFact env) facts
-- []
validateFact :: Env -> Fact -> [ValidationError]
validateFact env = flip runReader env . V.validateFact

View File

@ -11,7 +11,7 @@ module Ringo.Extractor
import qualified Data.Map as Map
import qualified Data.Tree as Tree
import Control.Monad.Reader (Reader, asks)
import Control.Monad.Reader (Reader, asks, withReader)
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.List (nub)
@ -22,57 +22,58 @@ import Ringo.Utils
extractFactTable :: Fact -> Reader Env Table
extractFactTable fact = do
Settings {..} <- asks envSettings
allDims <- extractAllDimensionTables fact
tables <- asks envTables
let table = fromJust . findTable (factTableName fact) $ tables
allDims <- extractAllDimensionTables fact
withReader envView $ do
Settings {..} <- asks envSettings
tables <- asks envTables
let table = fromJust . findTable (factTableName fact) $ tables
let countColType = settingFactCountColumnType
dimIdColName = settingDimTableIdColumnName
sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull }
notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
let countColType = settingFactCountColumnType
dimIdColName = settingDimTableIdColumnName
sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull }
notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime ->
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
NoDimId -> [ notNullSourceColumnCopy cName ]
TenantId -> [ notNullSourceColumnCopy cName ]
FactCount {..} -> [ Column cName countColType NotNull ]
FactCountDistinct {..} -> [ Column cName "json" NotNull ]
FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactAverage {..} ->
[ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
, notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
]
_ -> []
columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime ->
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
NoDimId -> [ notNullSourceColumnCopy cName ]
TenantId -> [ notNullSourceColumnCopy cName ]
FactCount {..} -> [ Column cName countColType NotNull ]
FactCountDistinct {..} -> [ Column cName "json" NotNull ]
FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactAverage {..} ->
[ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
, notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
]
_ -> []
fkColumns = for allDims $ \(dimFact, dimTable) ->
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables
colType = idColTypeToFKIdColType settingDimTableIdColumnType
in Column colName colType NotNull
fkColumns = for allDims $ \(dimFact, dimTable) ->
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables
colType = idColTypeToFKIdColType settingDimTableIdColumnType
in Column colName colType NotNull
ukColNames =
(++ map columnName fkColumns)
. forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
NoDimId -> Just cName
TenantId -> Just cName
_ -> Nothing
ukColNames =
(++ map columnName fkColumns)
. forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
NoDimId -> Just cName
TenantId -> Just cName
_ -> Nothing
return Table
{ tableName =
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
, tableColumns = columns ++ fkColumns
, tableConstraints = [ UniqueKey ukColNames ]
}
return Table
{ tableName =
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
, tableColumns = columns ++ fkColumns
, tableConstraints = [ UniqueKey ukColNames ]
}
extractDependencies :: Fact -> Reader Env Dependencies
extractDependencies fact = do
extractDependencies fact = withReader envView $ do
settings@Settings{..} <- asks envSettings
facts <- asks envFacts
let factSourceDeps =

View File

@ -13,7 +13,7 @@ import qualified Data.Text as Text
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks)
import Control.Monad.Reader (Reader, asks, withReader)
import Data.Function (on)
import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes)
import Data.Monoid ((<>))
@ -59,7 +59,7 @@ idColTypeToFKIdColType typ = case Text.toLower typ of
_ -> typ
extractDimensionTables :: Fact -> Reader Env [Table]
extractDimensionTables fact = do
extractDimensionTables fact = withReader envView $ do
settings <- asks envSettings
tables <- asks envTables
let table = fromJust . findTable (factTableName fact) $ tables
@ -99,4 +99,5 @@ extractAllDimensionTables fact = do
parentDims <- concat <$> mapM extract (factParentNames fact)
return . nubBy ((==) `on` snd) $ myDims ++ parentDims
where
extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName
extract fName =
asks (envFacts . envView) >>= extractAllDimensionTables . fromJust . findFact fName

View File

@ -11,7 +11,7 @@ module Ringo.Generator.Create (dimensionTableDefnSQL, factTableDefnSQL) where
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks)
import Control.Monad.Reader (Reader, asks, withReader)
import Database.HsSqlPpp.Syntax ( Statement(..), RowConstraint(..), AlterTableAction(..)
, AlterTableOperation(..), Constraint(..), Cascade(..) )
import Data.Maybe (listToMaybe, maybeToList)
@ -24,7 +24,7 @@ import Ringo.Types
import Ringo.Utils
tableDefnStmts :: Table -> Reader Env [Statement]
tableDefnStmts Table {..} = do
tableDefnStmts Table {..} = withReader envView $ do
Settings {..} <- asks envSettings
let tabName = tableName <> settingTableNameSuffixTemplate
@ -58,7 +58,7 @@ dimensionTableDefnSQL :: Table -> Reader Env [Text]
dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts
dimensionTableIndexStmts :: Table -> Reader Env [Statement]
dimensionTableIndexStmts Table {..} = do
dimensionTableIndexStmts Table {..} = withReader envView $do
Settings {..} <- asks envSettings
let tabName = tableName <> settingTableNameSuffixTemplate
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ]
@ -72,25 +72,26 @@ factTableDefnSQL fact table = tableDefnSQL table (factTableIndexStmts fact)
factTableIndexStmts :: Fact -> Table -> Reader Env [Statement]
factTableIndexStmts fact table = do
Settings {..} <- asks envSettings
tables <- asks envTables
allDims <- extractAllDimensionTables fact
allDims <- extractAllDimensionTables fact
withReader envView $ do
Settings {..} <- asks envSettings
tables <- asks envTables
let dimTimeCol = head [ cName | DimTimeV cName <- factColumns fact ]
tenantIdCol = listToMaybe [ cName | TenantIdV cName <- factColumns fact ]
tabName = tableName table <> settingTableNameSuffixTemplate
dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
let dimTimeCol = head [ cName | DimTimeV cName <- factColumns fact ]
tenantIdCol = listToMaybe [ cName | TenantIdV cName <- factColumns fact ]
tabName = tableName table <> settingTableNameSuffixTemplate
dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime -> Just [dimTimeColName cName]
NoDimId -> Just [cName]
TenantId -> Just [cName]
_ -> Nothing
factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime -> Just [dimTimeColName cName]
NoDimId -> Just [cName]
TenantId -> Just [cName]
_ -> Nothing
dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ]
| (dimFact, dimTable) <- allDims ]
dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ]
| (dimFact, dimTable) <- allDims ]
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
| cName <- maybeToList tenantIdCol ] ]
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
| cName <- maybeToList tenantIdCol ] ]

View File

@ -10,7 +10,7 @@ module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks)
import Control.Monad.Reader (Reader, asks, withReader)
import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..))
import Data.Maybe (fromJust)
import Data.Text (Text)
@ -25,7 +25,7 @@ dimensionTablePopulateSQL popMode fact dimTableName =
ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName
dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement
dimensionTablePopulateStmt popMode fact dimTableName = do
dimensionTablePopulateStmt popMode fact dimTableName = withReader envView $ do
Settings {..} <- asks envSettings
tables <- asks envTables
defaults <- asks envTypeDefaults

View File

@ -16,7 +16,7 @@ import qualified Data.Text as Text
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks)
import Control.Monad.Reader (Reader, asks, withReader)
import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect
, SelectList(..), SelectItem(..), JoinType(..) )
import Data.List (nub)
@ -57,7 +57,7 @@ $$
LANGUAGE 'plpgsql' IMMUTABLE;
|]
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement]
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader EnvV [Statement]
factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
Select {selSelectList = SelectList _ origSelectItems, ..} -> do
Settings {..} <- asks envSettings
@ -126,107 +126,108 @@ factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement]
factTablePopulateStmts popMode fact = do
Settings {..} <- asks envSettings
allDims <- extractAllDimensionTables fact
tables <- asks envTables
defaults <- asks envTypeDefaults
let fTableName = factTableName fact
fTable = fromJust . findTable fTableName $ tables
dimIdColName = settingDimTableIdColumnName
allDims <- extractAllDimensionTables fact
withReader envView $ do
Settings {..} <- asks envSettings
tables <- asks envTables
defaults <- asks envTypeDefaults
let fTableName = factTableName fact
fTable = fromJust . findTable fTableName $ tables
dimIdColName = settingDimTableIdColumnName
coalesceFKId ex =
app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ]
coalesceFKId ex =
app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ]
timeUnitColumnInsertSQL cName =
let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
in ( colName
, cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName))
(num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ])
"bigint"
, True
)
dimIdColumnInsertSQL cName =
let sCol = fromJust . findColumn cName $ tableColumns fTable
in (cName, coalesceColumn defaults fTableName sCol, True)
timeUnitColumnInsertSQL cName =
let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
in ( colName
, cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName))
(num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ])
"bigint"
, True
)
dimIdColumnInsertSQL cName =
let sCol = fromJust . findColumn cName $ tableColumns fTable
in (cName, coalesceColumn defaults fTableName sCol, True)
app' f cName = app f [ eqi fTableName cName ]
app' f cName = app f [ eqi fTableName cName ]
factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime -> [ timeUnitColumnInsertSQL cName ]
NoDimId -> [ dimIdColumnInsertSQL cName ]
TenantId -> [ dimIdColumnInsertSQL cName ]
FactCount {..} ->
[ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ]
FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ]
FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ]
FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ]
FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ]
FactAverage {..} ->
[ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False )
, ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False)
]
_ -> []
factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
DimTime -> [ timeUnitColumnInsertSQL cName ]
NoDimId -> [ dimIdColumnInsertSQL cName ]
TenantId -> [ dimIdColumnInsertSQL cName ]
FactCount {..} ->
[ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ]
FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ]
FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ]
FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ]
FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ]
FactAverage {..} ->
[ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False )
, ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False)
]
_ -> []
dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
dimFKIdColName =
factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables
factSourceTableName = factTableName dimFact
factSourceTable = fromJust . findTable factSourceTableName $ tables
dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable
dimLookupWhereClauses = Just . foldBinop "and" $
[ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol)
| (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName
, let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ]
insertExpr = if factTable `elem` tables -- existing dimension table
then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id)
$ eqi factSourceTableName dimFKIdColName
else coalesceFKId . subQueryExp $
makeSelect
{ selSelectList = sl [ si $ ei dimIdColName ]
, selTref =
[ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ]
, selWhere = dimLookupWhereClauses
}
in (dimFKIdColName, insertExpr, True)
dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
dimFKIdColName =
factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables
factSourceTableName = factTableName dimFact
factSourceTable = fromJust . findTable factSourceTableName $ tables
dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable
dimLookupWhereClauses = Just . foldBinop "and" $
[ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol)
| (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName
, let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ]
insertExpr = if factTable `elem` tables -- existing dimension table
then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id)
$ eqi factSourceTableName dimFKIdColName
else coalesceFKId . subQueryExp $
makeSelect
{ selSelectList = sl [ si $ ei dimIdColName ]
, selTref =
[ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ]
, selWhere = dimLookupWhereClauses
}
in (dimFKIdColName, insertExpr, True)
colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
| (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ]
colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
| (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ]
joinClauses =
map (tref &&& joinClausePreds fTable)
. filter (/= fTableName)
. nub
. map (factTableName . fst)
$ allDims
joinClauses =
map (tref &&& joinClausePreds fTable)
. filter (/= fTableName)
. nub
. map (factTableName . fst)
$ allDims
timeCol = eqi fTableName $ head [ cName | DimTimeV cName <- factColumns fact ]
timeCol = eqi fTableName $ head [ cName | DimTimeV cName <- factColumns fact ]
extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
populateSelectExpr =
makeSelect
{ selSelectList = sl . map (uncurry sia . snd3) $ colMap
, selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ]
, selWhere = Just . foldBinop "and" $
binop "<" timeCol placeholder :
[ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ]
, selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap
}
populateSelectExpr =
makeSelect
{ selSelectList = sl . map (uncurry sia . snd3) $ colMap
, selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ]
, selWhere = Just . foldBinop "and" $
binop "<" timeCol placeholder :
[ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ]
, selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap
}
insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr
return $ insertIntoStmt : updateStmts
where
groupByColPrefix = "xxff_"
updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr
return $ insertIntoStmt : updateStmts
where
groupByColPrefix = "xxff_"
joinClausePreds table oTableName =
foldBinop "and"
. map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2))
<$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table
, tName == oTableName ]
joinClausePreds table oTableName =
foldBinop "and"
. map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2))
<$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table
, tName == oTableName ]
factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text]
factTablePopulateSQL popMode fact = do

View File

@ -5,186 +5,25 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
module Ringo.Types where
module Ringo.Types
( ColumnName, ColumnType, TableName
, Nullable(..), Column(..), TableConstraint(..), Table(..)
, TimeUnit(..), timeUnitName, timeUnitToSeconds
, Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName
, pattern DimTimeV
, pattern NoDimIdV
, pattern TenantIdV
, pattern DimIdV
, pattern DimValV
, pattern FactCountV
, pattern FactCountDistinctV
, pattern FactSumV
, pattern FactAverageV
, pattern FactMaxV
, pattern FactMinV
, Settings(..), defSettings
, ValidationError(..), TypeDefaults
, Env, EnvV(..), envView
, TablePopulationMode(..), Dependencies) where
import qualified Data.Text as Text
import Data.Map (Map)
import Data.Monoid ((<>))
import Data.Text (Text)
showColNames :: [Text] -> String
showColNames cols = Text.unpack $ "(" <> Text.intercalate ", " cols <> ")"
type ColumnName = Text
type ColumnType = Text
type TableName = Text
data Nullable = Null | NotNull deriving (Eq, Enum)
instance Show Nullable where
show Null = "NULL"
show NotNull = "NOT NULL"
data Column = Column
{ columnName :: !ColumnName
, columnType :: !ColumnType
, columnNullable :: !Nullable
} deriving (Eq)
instance Show Column where
show Column {..} = "Column "
++ Text.unpack columnName ++ " "
++ Text.unpack columnType ++ " "
++ show columnNullable
data TableConstraint = PrimaryKey !ColumnName
| UniqueKey ![ColumnName]
| ForeignKey !TableName ![(ColumnName, ColumnName)]
deriving (Eq)
instance Show TableConstraint where
show (PrimaryKey col) = "PrimaryKey " ++ Text.unpack col
show (UniqueKey cols) = "UniqueKey " ++ showColNames cols
show (ForeignKey tName colMap) = "ForeignKey " ++ showColNames (map fst colMap) ++ " "
++ Text.unpack tName ++ " " ++ showColNames (map snd colMap)
data Table = Table
{ tableName :: !TableName
, tableColumns :: ![Column]
, tableConstraints :: ![TableConstraint]
} deriving (Eq)
instance Show Table where
show Table {..} =
unlines $ ("Table " ++ Text.unpack tableName) : map show tableColumns ++ map show tableConstraints
data TimeUnit = Second | Minute | Hour | Day | Week
deriving (Eq, Enum, Show, Read)
timeUnitName :: TimeUnit -> Text
timeUnitName = Text.toLower . Text.pack . show
timeUnitToSeconds :: TimeUnit -> Int
timeUnitToSeconds Second = 1
timeUnitToSeconds Minute = 60 * timeUnitToSeconds Second
timeUnitToSeconds Hour = 60 * timeUnitToSeconds Minute
timeUnitToSeconds Day = 24 * timeUnitToSeconds Hour
timeUnitToSeconds Week = 7 * timeUnitToSeconds Day
data Fact = Fact
{ factName :: !TableName
, factTableName :: !TableName
, factTablePersistent :: !Bool
, factParentNames :: ![TableName]
, factColumns :: ![FactColumn]
} deriving (Show)
data FCTNone
data FCTTargetTable
data FCTMaybeSourceColumn
data FCTSourceColumn
data FactColumnType a where
DimTime :: FactColumnType FCTNone
NoDimId :: FactColumnType FCTNone
TenantId :: FactColumnType FCTNone
DimId :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable
DimVal :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable
FactCount :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn
FactCountDistinct :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn
FactSum :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
FactAverage :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
FactMax :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
FactMin :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
deriving instance Show (FactColumnType a)
pattern DimTimeV col <- FactColumn col DimTime
pattern NoDimIdV col <- FactColumn col NoDimId
pattern TenantIdV col <- FactColumn col TenantId
pattern DimIdV col <- FactColumn col DimId {..}
pattern DimValV col <- FactColumn col DimVal {..}
pattern FactCountV col <- FactColumn col FactCount {..}
pattern FactCountDistinctV col <- FactColumn col FactCountDistinct {..}
pattern FactSumV col <- FactColumn col FactSum {..}
pattern FactAverageV col <- FactColumn col FactAverage {..}
pattern FactMaxV col <- FactColumn col FactMax {..}
pattern FactMinV col <- FactColumn col FactMin {..}
data FactColumn = forall a. FactColumn
{ factColTargetColumn :: !ColumnName
, factColType :: FactColumnType a }
deriving instance Show FactColumn
factSourceColumnName :: FactColumn -> Maybe ColumnName
factSourceColumnName FactColumn {..} = case factColType of
DimTime -> Just factColTargetColumn
NoDimId -> Just factColTargetColumn
TenantId -> Just factColTargetColumn
DimId {..} -> Just factColTargetColumn
DimVal {..} -> Just factColTargetColumn
FactCount {..} -> factColMaybeSourceColumn
FactCountDistinct {..} -> factColMaybeSourceColumn
FactSum {..} -> Just factColSourceColumn
FactAverage {..} -> Just factColSourceColumn
FactMax {..} -> Just factColSourceColumn
FactMin {..} -> Just factColSourceColumn
data Settings = Settings
{ settingDimPrefix :: !Text
, settingFactPrefix :: !Text
, settingTimeUnit :: !TimeUnit
, settingAvgCountColumSuffix :: !Text
, settingAvgSumColumnSuffix :: !Text
, settingDimTableIdColumnName :: !Text
, settingDimTableIdColumnType :: !Text
, settingFactCountColumnType :: !Text
, settingFactCountDistinctErrorRate :: !Double
, settingFactInfix :: !Text
, settingDependenciesJSONFileName :: !Text
, settingFactsJSONFileName :: !Text
, settingDimensionJSONFileName :: !Text
, settingForeignKeyIdCoalesceValue :: !Int
, settingTableNameSuffixTemplate :: !Text
} deriving (Eq, Show)
defSettings :: Settings
defSettings = Settings
{ settingDimPrefix = "dim_"
, settingFactPrefix = "fact_"
, settingTimeUnit = Minute
, settingAvgCountColumSuffix = "_count"
, settingAvgSumColumnSuffix = "_sum"
, settingDimTableIdColumnName = "id"
, settingDimTableIdColumnType = "serial"
, settingFactCountColumnType = "integer"
, settingFactCountDistinctErrorRate = 0.05
, settingFactInfix = "_by_"
, settingDependenciesJSONFileName = "dependencies.json"
, settingFactsJSONFileName = "facts.json"
, settingDimensionJSONFileName = "dimensions.json"
, settingForeignKeyIdCoalesceValue = -1
, settingTableNameSuffixTemplate = "{{suff}}"
}
data ValidationError = MissingTable !TableName
| MissingFact !TableName
| MissingColumn !TableName !ColumnName
| MissingTimeColumn !TableName
| MissingNotNullConstraint !TableName !ColumnName
| MissingTypeDefault !Text
deriving (Eq, Show)
type TypeDefaults = Map Text Text
data Env = Env
{ envTables :: ![Table]
, envFacts :: ![Fact]
, envSettings :: !Settings
, envTypeDefaults :: !TypeDefaults
} deriving (Show)
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)
type Dependencies = Map TableName [TableName]
import Ringo.Types.Internal

198
src/Ringo/Types/Internal.hs Normal file
View File

@ -0,0 +1,198 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
module Ringo.Types.Internal where
import qualified Data.Text as Text
import Data.Map (Map)
import Data.Monoid ((<>))
import Data.Text (Text)
showColNames :: [Text] -> String
showColNames cols = Text.unpack $ "(" <> Text.intercalate ", " cols <> ")"
type ColumnName = Text
type ColumnType = Text
type TableName = Text
data Nullable = Null | NotNull deriving (Eq, Enum)
instance Show Nullable where
show Null = "NULL"
show NotNull = "NOT NULL"
data Column = Column
{ columnName :: !ColumnName
, columnType :: !ColumnType
, columnNullable :: !Nullable
} deriving (Eq)
instance Show Column where
show Column {..} = "Column "
++ Text.unpack columnName ++ " "
++ Text.unpack columnType ++ " "
++ show columnNullable
data TableConstraint = PrimaryKey !ColumnName
| UniqueKey ![ColumnName]
| ForeignKey !TableName ![(ColumnName, ColumnName)]
deriving (Eq)
instance Show TableConstraint where
show (PrimaryKey col) = "PrimaryKey " ++ Text.unpack col
show (UniqueKey cols) = "UniqueKey " ++ showColNames cols
show (ForeignKey tName colMap) = "ForeignKey " ++ showColNames (map fst colMap) ++ " "
++ Text.unpack tName ++ " " ++ showColNames (map snd colMap)
data Table = Table
{ tableName :: !TableName
, tableColumns :: ![Column]
, tableConstraints :: ![TableConstraint]
} deriving (Eq)
instance Show Table where
show Table {..} =
unlines $ ("Table " ++ Text.unpack tableName) : map show tableColumns ++ map show tableConstraints
data TimeUnit = Second | Minute | Hour | Day | Week
deriving (Eq, Enum, Show, Read)
timeUnitName :: TimeUnit -> Text
timeUnitName = Text.toLower . Text.pack . show
timeUnitToSeconds :: TimeUnit -> Int
timeUnitToSeconds Second = 1
timeUnitToSeconds Minute = 60 * timeUnitToSeconds Second
timeUnitToSeconds Hour = 60 * timeUnitToSeconds Minute
timeUnitToSeconds Day = 24 * timeUnitToSeconds Hour
timeUnitToSeconds Week = 7 * timeUnitToSeconds Day
data Fact = Fact
{ factName :: !TableName
, factTableName :: !TableName
, factTablePersistent :: !Bool
, factParentNames :: ![TableName]
, factColumns :: ![FactColumn]
} deriving (Show)
data FCTNone
data FCTTargetTable
data FCTMaybeSourceColumn
data FCTSourceColumn
data FactColumnType a where
DimTime :: FactColumnType FCTNone
NoDimId :: FactColumnType FCTNone
TenantId :: FactColumnType FCTNone
DimId :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable
DimVal :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable
FactCount :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn
FactCountDistinct :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn
FactSum :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
FactAverage :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
FactMax :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
FactMin :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn
deriving instance Show (FactColumnType a)
pattern DimTimeV col <- FactColumn col DimTime
pattern NoDimIdV col <- FactColumn col NoDimId
pattern TenantIdV col <- FactColumn col TenantId
pattern DimIdV col <- FactColumn col DimId {..}
pattern DimValV col <- FactColumn col DimVal {..}
pattern FactCountV col <- FactColumn col FactCount {..}
pattern FactCountDistinctV col <- FactColumn col FactCountDistinct {..}
pattern FactSumV col <- FactColumn col FactSum {..}
pattern FactAverageV col <- FactColumn col FactAverage {..}
pattern FactMaxV col <- FactColumn col FactMax {..}
pattern FactMinV col <- FactColumn col FactMin {..}
data FactColumn = forall a. FactColumn
{ factColTargetColumn :: !ColumnName
, factColType :: FactColumnType a }
deriving instance Show FactColumn
factSourceColumnName :: FactColumn -> Maybe ColumnName
factSourceColumnName FactColumn {..} = case factColType of
DimTime -> Just factColTargetColumn
NoDimId -> Just factColTargetColumn
TenantId -> Just factColTargetColumn
DimId {..} -> Just factColTargetColumn
DimVal {..} -> Just factColTargetColumn
FactCount {..} -> factColMaybeSourceColumn
FactCountDistinct {..} -> factColMaybeSourceColumn
FactSum {..} -> Just factColSourceColumn
FactAverage {..} -> Just factColSourceColumn
FactMax {..} -> Just factColSourceColumn
FactMin {..} -> Just factColSourceColumn
data Settings = Settings
{ settingDimPrefix :: !Text
, settingFactPrefix :: !Text
, settingTimeUnit :: !TimeUnit
, settingAvgCountColumSuffix :: !Text
, settingAvgSumColumnSuffix :: !Text
, settingDimTableIdColumnName :: !Text
, settingDimTableIdColumnType :: !Text
, settingFactCountColumnType :: !Text
, settingFactCountDistinctErrorRate :: !Double
, settingFactInfix :: !Text
, settingDependenciesJSONFileName :: !Text
, settingFactsJSONFileName :: !Text
, settingDimensionJSONFileName :: !Text
, settingForeignKeyIdCoalesceValue :: !Int
, settingTableNameSuffixTemplate :: !Text
} deriving (Eq, Show)
defSettings :: Settings
defSettings = Settings
{ settingDimPrefix = "dim_"
, settingFactPrefix = "fact_"
, settingTimeUnit = Minute
, settingAvgCountColumSuffix = "_count"
, settingAvgSumColumnSuffix = "_sum"
, settingDimTableIdColumnName = "id"
, settingDimTableIdColumnType = "serial"
, settingFactCountColumnType = "integer"
, settingFactCountDistinctErrorRate = 0.05
, settingFactInfix = "_by_"
, settingDependenciesJSONFileName = "dependencies.json"
, settingFactsJSONFileName = "facts.json"
, settingDimensionJSONFileName = "dimensions.json"
, settingForeignKeyIdCoalesceValue = -1
, settingTableNameSuffixTemplate = "{{suff}}"
}
data ValidationError = MissingTable !TableName
| DuplicateTable !TableName
| MissingFact !TableName
| DuplicateFact !TableName
| MissingColumn !TableName !ColumnName
| DuplicateColumn !TableName !ColumnName
| MissingTimeColumn !TableName
| MissingNotNullConstraint !TableName !ColumnName
| MissingTypeDefault !Text
deriving (Eq, Show)
type TypeDefaults = Map Text Text
data Env = Env ![Table] ![Fact] !Settings !TypeDefaults
data EnvV = EnvV
{ envTables :: ![Table]
, envFacts :: ![Fact]
, envSettings :: !Settings
, envTypeDefaults :: !TypeDefaults
} deriving (Show)
envView :: Env -> EnvV
envView (Env tables facts settings typeDefaults) = EnvV tables facts settings typeDefaults
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)
type Dependencies = Map TableName [TableName]

View File

@ -34,6 +34,14 @@ second = Arrow.second
(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)
(&&&) = (Arrow.&&&)
(>>>) :: (a -> b) -> (b -> c) -> (a -> c)
(>>>) = (Arrow.>>>)
(>>-) :: a -> (a -> b) -> b
(>>-) v f = f v
infixr 1 >>-
dupe :: a -> (a,a)
dupe x = (x, x)

View File

@ -4,10 +4,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
module Ringo.Validator
( validateTable
, validateFact
) where
module Ringo.Validator (validateEnv) where
import qualified Data.Map as Map
import qualified Data.Text as Text
@ -17,20 +14,25 @@ import qualified Data.Text as Text
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks)
import Control.Monad.Reader (Reader, ask, runReader)
import Data.Maybe (isJust, fromJust)
import Data.List (nub, group, sort)
import Ringo.Extractor.Internal
import Ringo.Types
import Ringo.Types.Internal
import Ringo.Utils
data RawEnv = RawEnv ![Table] ![Fact] !Settings !TypeDefaults deriving (Show)
checkTableForCol :: Table -> ColumnName -> [ValidationError]
checkTableForCol tab colName =
[ MissingColumn (tableName tab) colName |
not . any ((colName ==) . columnName) . tableColumns $ tab ]
validateTable :: Table -> Reader Env [ValidationError]
validateTable :: Table -> Reader RawEnv [ValidationError]
validateTable table = do
tables <- asks envTables
RawEnv tables _ _ _ <- ask
return . concatMap (checkConstraint tables) . tableConstraints $ table
where
checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName
@ -43,10 +45,10 @@ validateTable table = do
checkTableForColRefs tab = concatMap (checkTableForCol tab)
validateFact :: Fact -> Reader Env [ValidationError]
validateFact :: Fact -> Reader RawEnv [ValidationError]
validateFact Fact {..} = do
tables <- asks envTables
defaults <- Map.keys <$> asks envTypeDefaults
RawEnv tables _ _ typeDefaults <- ask
let defaults = Map.keys typeDefaults
case findTable factTableName tables of
Nothing -> return [ MissingTable factTableName ]
Just table -> do
@ -75,7 +77,7 @@ validateFact Fact {..} = do
return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs
where
checkFactParents fName = do
facts <- asks envFacts
RawEnv _ facts _ _ <- ask
case findFact fName facts of
Nothing -> return [ MissingFact fName ]
Just pFact -> validateFact pFact
@ -88,3 +90,21 @@ validateFact Fact {..} = do
checkColumnTable tables FactColumn {..} = case factColType of
DimId {factColTargetTable = tName} -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
_ -> []
validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env
validateEnv tables facts settings typeDefaults =
flip runReader (RawEnv tables facts settings typeDefaults) $ do
tableVs <- concat <$> mapM validateTable tables
factVs <- concat <$> mapM validateFact facts
let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
let dupFactVs = [ DuplicateFact fact | fact <- findDups . map factName $ facts ]
let dupColVs = [ DuplicateColumn tableName col
| Table{..} <- tables
, col <- findDups . map columnName $ tableColumns ]
let vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs
if null vs
then return . Right $ Env tables facts settings typeDefaults
else return . Left $ vs
where
findDups =
sort >>> group >>> map (head &&& length) >>> filter (snd >>> (> 1)) >>> map fst