Changes FactColumn to use GADTs for better type safety.
parent
8c3c4d801d
commit
0f4970d587
|
|
@ -53,17 +53,17 @@ instance FromJSON FactColumn where
|
|||
parseJSON (Object o) = do
|
||||
cType <- o .: "type"
|
||||
case cType of
|
||||
"dimtime" -> DimTime <$> o .: "column"
|
||||
"nodimid" -> NoDimId <$> o .: "column"
|
||||
"tenantid" -> TenantId <$> o .: "column"
|
||||
"dimid" -> DimId <$> o .: "table" <*> o .: "column"
|
||||
"dimval" -> DimVal <$> o .: "table" <*> o .: "column"
|
||||
"factcount" -> FactCount <$> o .:? "sourcecolumn" <*> o .: "column"
|
||||
"factsum" -> FactSum <$> o .: "sourcecolumn" <*> o .: "column"
|
||||
"factaverage" -> FactAverage <$> o .: "sourcecolumn" <*> o .: "column"
|
||||
"factcountdistinct" -> FactCountDistinct <$> o .:? "sourcecolumn" <*> o .: "column"
|
||||
"factmax" -> FactMax <$> o .: "sourcecolumn" <*> o .: "column"
|
||||
"factmin" -> FactMin <$> o .: "sourcecolumn" <*> o .: "column"
|
||||
"dimtime" -> FactColumn <$> o .: "column" <*> pure DimTime
|
||||
"nodimid" -> FactColumn <$> o .: "column" <*> pure NoDimId
|
||||
"tenantid" -> FactColumn <$> o .: "column" <*> pure TenantId
|
||||
"dimid" -> FactColumn <$> o .: "column" <*> (DimId <$> o .: "table")
|
||||
"dimval" -> FactColumn <$> o .: "column" <*> (DimVal <$> o .: "table")
|
||||
"factcount" -> FactColumn <$> o .: "column" <*> (FactCount <$> o .:? "sourcecolumn")
|
||||
"factcountdistinct" -> FactColumn <$> o .: "column" <*> (FactCountDistinct <$> o .:? "sourcecolumn")
|
||||
"factsum" -> FactColumn <$> o .: "column" <*> (FactSum <$> o .: "sourcecolumn")
|
||||
"factaverage" -> FactColumn <$> o .: "column" <*> (FactAverage <$> o .: "sourcecolumn")
|
||||
"factmax" -> FactColumn <$> o .: "column" <*> (FactMax <$> o .: "sourcecolumn")
|
||||
"factmin" -> FactColumn <$> o .: "column" <*> (FactMin <$> o .: "sourcecolumn")
|
||||
_ -> fail $ "Invalid fact column type: " ++ cType
|
||||
parseJSON o = fail $ "Cannot parse fact column: " ++ show o
|
||||
|
||||
|
|
@ -75,7 +75,7 @@ instance FromJSON Fact where
|
|||
<*> o .: "columns"
|
||||
parseJSON o = fail $ "Cannot parse fact: " ++ show o
|
||||
|
||||
data Input = Input [Table] [Fact] TypeDefaults deriving (Eq, Show)
|
||||
data Input = Input [Table] [Fact] TypeDefaults deriving (Show)
|
||||
|
||||
instance FromJSON Input where
|
||||
parseJSON (Object o) = Input <$> o .: "tables" <*> o .: "facts" <*> o .: "defaults"
|
||||
|
|
|
|||
|
|
@ -33,7 +33,8 @@ library
|
|||
mtl >=2.1 && <2.3,
|
||||
raw-strings-qq >=1.0 && <1.2,
|
||||
hssqlppp ==0.5.23
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans -O2
|
||||
ghc-options: -Wall -Werror -fwarn-incomplete-uni-patterns -fno-warn-unused-do-bind
|
||||
-fno-warn-orphans -funbox-strict-fields -O2
|
||||
default-language: Haskell2010
|
||||
|
||||
executable ringo
|
||||
|
|
@ -52,7 +53,8 @@ executable ringo
|
|||
filepath >=1.3 && <1.5,
|
||||
aeson >=0.8 && <0.11,
|
||||
ringo
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans -O2
|
||||
ghc-options: -Wall -Werror -fwarn-incomplete-uni-patterns -fno-warn-unused-do-bind
|
||||
-fno-warn-orphans -funbox-strict-fields -O2
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite ringo-test
|
||||
|
|
|
|||
29
src/Ringo.hs
29
src/Ringo.hs
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Ringo
|
||||
( -- | The examples in this module assume the following code has been run.
|
||||
-- The :{ and :} will only work in GHCi.
|
||||
|
|
@ -64,15 +63,15 @@ import qualified Ringo.Validator as V
|
|||
-- , factTablePersistent = True
|
||||
-- , factParentNames = []
|
||||
-- , factColumns =
|
||||
-- [ DimTime "created_at"
|
||||
-- , NoDimId "publisher_id"
|
||||
-- , DimVal "user_agent" "browser_name"
|
||||
-- , DimVal "user_agent" "os"
|
||||
-- , DimVal "user_agent" "user_agent_name"
|
||||
-- , DimVal "geo" "geo_country_name"
|
||||
-- , DimVal "geo" "geo_city_name"
|
||||
-- , DimVal "geo" "geo_continent_name"
|
||||
-- , FactCount Nothing "session_count"
|
||||
-- [ FactColumn "created_at" $ DimTime
|
||||
-- , FactColumn "publisher_id" $ NoDimId
|
||||
-- , FactColumn "browser_name" $ DimVal "user_agent"
|
||||
-- , FactColumn "os" $ DimVal "user_agent"
|
||||
-- , FactColumn "user_agent_name" $ DimVal "user_agent"
|
||||
-- , FactColumn "geo_country_name" $ DimVal "geo"
|
||||
-- , FactColumn "geo_city_name" $ DimVal "geo"
|
||||
-- , FactColumn "geo_continent_name" $ DimVal "geo"
|
||||
-- , FactColumn "session_count" $ FactCount Nothing
|
||||
-- ]
|
||||
-- }
|
||||
-- pageViewEventsTable =
|
||||
|
|
@ -105,11 +104,11 @@ import qualified Ringo.Validator as V
|
|||
-- , factTablePersistent = True
|
||||
-- , factParentNames = [ "session" ]
|
||||
-- , factColumns =
|
||||
-- [ DimTime "created_at"
|
||||
-- , NoDimId "publisher_id"
|
||||
-- , DimVal "page_type" "page_type"
|
||||
-- , DimId "referrers" "referrer_id"
|
||||
-- , FactCount Nothing "view_count"
|
||||
-- [ FactColumn "created_at" $ DimTime
|
||||
-- , FactColumn "publisher_id" $ NoDimId
|
||||
-- , FactColumn "page_type" $ DimVal "page_type"
|
||||
-- , FactColumn "referrer_id" $ DimId "referrers"
|
||||
-- , FactColumn "view_count" $ FactCount Nothing
|
||||
-- ]
|
||||
-- }
|
||||
-- referrersTable =
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
module Ringo.Extractor
|
||||
( extractDimensionTables
|
||||
, extractAllDimensionTables
|
||||
|
|
@ -32,20 +33,21 @@ extractFactTable fact = do
|
|||
notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull }
|
||||
notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
|
||||
|
||||
columns = concatFor (factColumns fact) $ \col -> case col of
|
||||
DimTime cName ->
|
||||
columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime ->
|
||||
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
|
||||
NoDimId cName -> [ notNullSourceColumnCopy cName ]
|
||||
TenantId cName -> [ notNullSourceColumnCopy cName ]
|
||||
FactCount _ cName -> [ Column cName countColType NotNull ]
|
||||
FactSum scName cName -> [ notNullSourceColumnRename scName cName ]
|
||||
FactMax scName cName -> [ notNullSourceColumnRename scName cName ]
|
||||
FactMin scName cName -> [ notNullSourceColumnRename scName cName ]
|
||||
FactAverage scName cName ->
|
||||
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 scName (cName <> settingAvgSumColumnSuffix)
|
||||
, notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
|
||||
]
|
||||
FactCountDistinct _ cName -> [ Column cName "json" NotNull ]
|
||||
_ -> []
|
||||
|
||||
fkColumns = for allDims $ \(dimFact, dimTable) ->
|
||||
|
|
@ -55,10 +57,11 @@ extractFactTable fact = do
|
|||
|
||||
ukColNames =
|
||||
(++ map columnName fkColumns)
|
||||
. forMaybe (factColumns fact) $ \col -> case col of
|
||||
DimTime cName -> Just (timeUnitColumnName dimIdColName cName settingTimeUnit)
|
||||
NoDimId cName -> Just cName
|
||||
TenantId cName -> Just cName
|
||||
. forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
|
||||
NoDimId -> Just cName
|
||||
TenantId -> Just cName
|
||||
_ -> Nothing
|
||||
|
||||
return Table
|
||||
|
|
@ -77,15 +80,15 @@ extractDependencies fact = do
|
|||
(factTableName fct, parentFacts fct facts)
|
||||
factDimDeps =
|
||||
nub . concat . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
|
||||
( forMaybe (factColumns fct) $ \col -> case col of
|
||||
DimVal table _ -> Just $ settingDimPrefix <> table
|
||||
DimId table _ -> Just table
|
||||
( forMaybe (factColumns fct) $ \FactColumn {..} -> case factColType of
|
||||
DimVal {..} -> Just $ settingDimPrefix <> factColTargetTable
|
||||
DimId {..} -> Just factColTargetTable
|
||||
_ -> Nothing
|
||||
, parentFacts fct facts
|
||||
)
|
||||
|
||||
dimDeps = Map.fromList [ (settingDimPrefix <> table, [factTableName fact])
|
||||
| DimVal table _ <- factColumns fact ]
|
||||
| FactColumn {factColType = DimVal table} <- factColumns fact ]
|
||||
|
||||
factDeps = Map.singleton (extractedTable settings) (factSourceDeps ++ factDimDeps)
|
||||
return $ Map.union dimDeps factDeps
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
module Ringo.Extractor.Internal where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
|
@ -41,7 +42,9 @@ timeUnitColumnName dimIdColName colName timeUnit =
|
|||
factDimFKIdColumnName :: Text -> Text -> Fact -> Table -> [Table] -> ColumnName
|
||||
factDimFKIdColumnName dimPrefix dimIdColName dimFact dimTable@Table { .. } tables =
|
||||
if dimTable `elem` tables
|
||||
then head [ cName | DimId tName cName <- factColumns dimFact, tName == tableName ]
|
||||
then head [ factColTargetColumn
|
||||
| FactColumn {factColType = DimId {..}, ..} <- factColumns dimFact
|
||||
, factColTargetTable == tableName ]
|
||||
else fromMaybe tableName (Text.stripPrefix dimPrefix tableName) <> "_" <> dimIdColName
|
||||
|
||||
extractedFactTableName :: Text -> Text -> TableName -> TimeUnit -> TableName
|
||||
|
|
@ -62,7 +65,9 @@ extractDimensionTables fact = do
|
|||
let table = fromJust . findTable (factTableName fact) $ tables
|
||||
return $ dimsFromIds tables ++ dimsFromVals settings (tableColumns table)
|
||||
where
|
||||
dimsFromIds tables = catMaybes [ findTable d tables | DimId d _ <- factColumns fact ]
|
||||
dimsFromIds tables =
|
||||
catMaybes [ findTable factColTargetTable tables
|
||||
| FactColumn {factColType = DimId {..}} <- factColumns fact ]
|
||||
|
||||
dimsFromVals Settings {..} tableColumns =
|
||||
map (\(dim, cols) ->
|
||||
|
|
@ -81,9 +86,9 @@ extractDimensionTables fact = do
|
|||
. nub)
|
||||
. Map.fromListWith (flip (++))
|
||||
. mapMaybe (\fcol -> do
|
||||
DimVal d col <- fcol
|
||||
column <- findColumn col tableColumns
|
||||
return (d, [ column ]))
|
||||
FactColumn {factColType = DimVal {..}, ..} <- fcol
|
||||
column <- findColumn factColTargetColumn tableColumns
|
||||
return (factColTargetTable, [ column ]))
|
||||
. map Just
|
||||
. factColumns
|
||||
$ fact
|
||||
|
|
|
|||
|
|
@ -1,6 +1,9 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module Ringo.Generator.Create (dimensionTableDefnSQL, factTableDefnSQL) where
|
||||
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
|
|
@ -73,20 +76,21 @@ factTableIndexStmts fact table = do
|
|||
tables <- asks envTables
|
||||
allDims <- extractAllDimensionTables fact
|
||||
|
||||
let dimTimeCol = head [ cName | DimTime cName <- factColumns fact ]
|
||||
tenantIdCol = listToMaybe [ cName | TenantId cName <- factColumns fact ]
|
||||
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) $ \col -> case col of
|
||||
DimTime cName -> Just [dimTimeColName cName]
|
||||
NoDimId cName -> Just [cName]
|
||||
TenantId cName -> Just [cName]
|
||||
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 ]
|
||||
|
||||
return [ CreateIndexTSQL ea (nmc "") (name $ tabName) (map nmc cols)
|
||||
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
|
||||
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
|
||||
| cName <- maybeToList tenantIdCol ] ]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
module Ringo.Generator.Internal where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
|
@ -16,9 +17,9 @@ import Ringo.Types
|
|||
|
||||
dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)]
|
||||
dimColumnMapping dimPrefix fact dimTableName =
|
||||
[ (dimColumnName dName cName, cName)
|
||||
| DimVal dName cName <- factColumns fact
|
||||
, dimPrefix <> dName == dimTableName ]
|
||||
[ (dimColumnName factColTargetTable factColTargetColumn, factColTargetColumn)
|
||||
| FactColumn { factColType = DimVal {..}, ..} <- factColumns fact
|
||||
, dimPrefix <> factColTargetTable == dimTableName ]
|
||||
|
||||
coalesceColumn :: TypeDefaults -> TableName -> Column -> ScalarExpr
|
||||
coalesceColumn defaults tName Column{..} =
|
||||
|
|
|
|||
|
|
@ -1,6 +1,8 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
|
||||
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
|
|
@ -32,7 +34,7 @@ dimensionTablePopulateStmt popMode fact dimTableName = do
|
|||
selectCols = [ flip sia (nmc cName) $ coalesceColumn defaults (factTableName fact) col
|
||||
| (_, cName) <- colMapping
|
||||
, let col = fromJust . findColumn cName $ tableColumns factTable ]
|
||||
timeCol = head [ cName | DimTime cName <- factColumns fact ]
|
||||
timeCol = head ([ cName | DimTimeV cName <- factColumns fact ] :: [ColumnName])
|
||||
isNotNullC = parens . foldBinop "or" . map (postop "isnotnull" . ei . snd) $ colMapping
|
||||
selectWhereC = Just . foldBinop "and" $
|
||||
[ isNotNullC, binop "<" (ei timeCol) placeholder ] ++
|
||||
|
|
|
|||
|
|
@ -4,6 +4,9 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module Ringo.Generator.Populate.Fact (factTablePopulateSQL) where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
|
@ -55,19 +58,20 @@ LANGUAGE 'plpgsql' IMMUTABLE;
|
|||
|]
|
||||
|
||||
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement]
|
||||
factCountDistinctUpdateStmts
|
||||
popMode fact groupByColPrefix ~Select {selSelectList = SelectList _ origSelectItems, ..} = do
|
||||
factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
|
||||
Select {selSelectList = SelectList _ origSelectItems, ..} -> do
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
let countDistinctCols = [ col | col@(FactCountDistinct _ _) <- factColumns fact]
|
||||
fTableName = factTableName fact
|
||||
let fTableName = factTableName fact
|
||||
fTable = fromJust . findTable fTableName $ tables
|
||||
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints fTable ]
|
||||
extFactTableName =
|
||||
suffixTableName popMode settingTableNameSuffixTemplate
|
||||
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
||||
|
||||
return $ for countDistinctCols $ \(FactCountDistinct scName cName) ->
|
||||
return $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
FactCountDistinct {factColMaybeSourceColumn = scName} ->
|
||||
let unqCol = cast (eqi fTableName (fromMaybe tablePKColName scName)) "text"
|
||||
|
||||
bucketSelectCols =
|
||||
|
|
@ -98,7 +102,7 @@ factCountDistinctUpdateStmts
|
|||
aggSelectClause =
|
||||
sia (app "json_object_agg" [ ei (cName <> "_bnum"), ei (cName <> "_bhash") ]) (nmc cName)
|
||||
|
||||
in update extFactTableName
|
||||
in Just $ update extFactTableName
|
||||
[ (cName, eqi "xyz" cName) ]
|
||||
[ subtrefa "xyz"
|
||||
makeSelect
|
||||
|
|
@ -110,6 +114,10 @@ factCountDistinctUpdateStmts
|
|||
[ binop "=" (eqi extFactTableName . fromJust . Text.stripPrefix groupByColPrefix $ col)
|
||||
(eqi "xyz" col)
|
||||
| col <- groupByCols ]
|
||||
|
||||
_ -> Nothing
|
||||
|
||||
_ -> return []
|
||||
where
|
||||
bucketCount :: Double -> Integer
|
||||
bucketCount errorRate =
|
||||
|
|
@ -143,20 +151,21 @@ factTablePopulateStmts popMode fact = do
|
|||
|
||||
app' f cName = app f [ eqi fTableName cName ]
|
||||
|
||||
factColMap = concatFor (factColumns fact) $ \col -> case col of
|
||||
DimTime cName -> [ timeUnitColumnInsertSQL cName ]
|
||||
NoDimId cName -> [ dimIdColumnInsertSQL cName ]
|
||||
TenantId cName -> [ dimIdColumnInsertSQL cName ]
|
||||
FactCount scName cName ->
|
||||
[ (cName, app "count" [ maybe star (eqi fTableName) scName ], False) ]
|
||||
FactSum scName cName -> [ (cName, app' "sum" scName, False) ]
|
||||
FactMax scName cName -> [ (cName, app' "max" scName, False) ]
|
||||
FactMin scName cName -> [ (cName, app' "min" scName, False) ]
|
||||
FactAverage scName cName ->
|
||||
[ ( cName <> settingAvgCountColumSuffix, app' "count" scName, False )
|
||||
, ( cName <> settingAvgSumColumnSuffix , app' "sum" scName , 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)
|
||||
]
|
||||
FactCountDistinct _ cName -> [ (cName, cast (str "{}") "json", False) ]
|
||||
_ -> []
|
||||
|
||||
dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
|
||||
|
|
@ -191,7 +200,7 @@ factTablePopulateStmts popMode fact = do
|
|||
. map (factTableName . fst)
|
||||
$ allDims
|
||||
|
||||
timeCol = eqi fTableName $ head [ cName | DimTime cName <- factColumns fact ]
|
||||
timeCol = eqi fTableName $ head [ cName | DimTimeV cName <- factColumns fact ]
|
||||
|
||||
extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate
|
||||
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
||||
|
|
|
|||
|
|
@ -1,6 +1,10 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module Ringo.Types where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
|
@ -44,7 +48,6 @@ instance Show TableConstraint where
|
|||
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]
|
||||
|
|
@ -53,7 +56,7 @@ data Table = Table
|
|||
|
||||
instance Show Table where
|
||||
show Table {..} =
|
||||
unlines $ ("Table " ++ Text.unpack tableName) : (map show tableColumns) ++ (map show tableConstraints)
|
||||
unlines $ ("Table " ++ Text.unpack tableName) : map show tableColumns ++ map show tableConstraints
|
||||
|
||||
data TimeUnit = Second | Minute | Hour | Day | Week
|
||||
deriving (Eq, Enum, Show, Read)
|
||||
|
|
@ -74,33 +77,59 @@ data Fact = Fact
|
|||
, factTablePersistent :: !Bool
|
||||
, factParentNames :: ![TableName]
|
||||
, factColumns :: ![FactColumn]
|
||||
} deriving (Eq, Show)
|
||||
} deriving (Show)
|
||||
|
||||
data FactColumn = DimTime !ColumnName
|
||||
| NoDimId !ColumnName
|
||||
| TenantId !ColumnName
|
||||
| DimId !TableName !ColumnName
|
||||
| DimVal !TableName !ColumnName
|
||||
| FactCount !(Maybe ColumnName) !ColumnName
|
||||
| FactSum !ColumnName !ColumnName
|
||||
| FactAverage !ColumnName !ColumnName
|
||||
| FactCountDistinct !(Maybe ColumnName) !ColumnName
|
||||
| FactMax !ColumnName !ColumnName
|
||||
| FactMin !ColumnName !ColumnName
|
||||
deriving (Eq, 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 (DimTime cName) = Just cName
|
||||
factSourceColumnName (NoDimId cName) = Just cName
|
||||
factSourceColumnName (TenantId cName) = Just cName
|
||||
factSourceColumnName (DimId _ cName) = Just cName
|
||||
factSourceColumnName (DimVal _ cName) = Just cName
|
||||
factSourceColumnName (FactCount cName _) = cName
|
||||
factSourceColumnName (FactSum cName _) = Just cName
|
||||
factSourceColumnName (FactAverage cName _) = Just cName
|
||||
factSourceColumnName (FactCountDistinct cName _) = cName
|
||||
factSourceColumnName (FactMax cName _) = Just cName
|
||||
factSourceColumnName (FactMin cName _) = Just cName
|
||||
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
|
||||
|
|
@ -154,7 +183,7 @@ data Env = Env
|
|||
, envFacts :: ![Fact]
|
||||
, envSettings :: !Settings
|
||||
, envTypeDefaults :: !TypeDefaults
|
||||
} deriving (Eq, Show)
|
||||
} deriving (Show)
|
||||
|
||||
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Ringo.Utils where
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,9 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module Ringo.Validator
|
||||
( validateTable
|
||||
, validateFact
|
||||
|
|
@ -51,17 +54,19 @@ validateFact Fact {..} = do
|
|||
parentVs <- concat <$> mapM checkFactParents factParentNames
|
||||
let colVs = concatMap (checkColumn tables table) factColumns
|
||||
timeVs = [ MissingTimeColumn factTableName
|
||||
| null [ c | DimTime c <- factColumns ] ]
|
||||
notNullVs = [ MissingNotNullConstraint factTableName c
|
||||
| DimTime c <- factColumns
|
||||
, let col = findColumn c (tableColumns table)
|
||||
| null ([ cName | DimTimeV cName <- factColumns ] :: [ColumnName]) ]
|
||||
notNullVs = [ MissingNotNullConstraint factTableName cName
|
||||
| DimTimeV cName <- factColumns
|
||||
, let col = findColumn cName (tableColumns table)
|
||||
, isJust col
|
||||
, columnNullable (fromJust col) == Null ]
|
||||
|
||||
typeDefaultVs =
|
||||
[ MissingTypeDefault cType
|
||||
| cName <- [ c | DimVal _ c <- factColumns ]
|
||||
++ [ c | NoDimId c <- factColumns ]
|
||||
++ [ c | TenantId c <- factColumns ]
|
||||
| cName <- [ c | DimValV c <- factColumns ]
|
||||
++ [ c | NoDimIdV c <- factColumns ]
|
||||
++ [ c | TenantIdV c <- factColumns ]
|
||||
++ [ c | DimIdV c <- factColumns ]
|
||||
, let col = findColumn cName (tableColumns table)
|
||||
, isJust col
|
||||
, let cType = columnType $ fromJust col
|
||||
|
|
@ -79,6 +84,7 @@ validateFact Fact {..} = do
|
|||
maybe [] (checkTableForCol table) (factSourceColumnName factCol)
|
||||
++ checkColumnTable tables factCol
|
||||
|
||||
checkColumnTable tables factCol = case factCol of
|
||||
DimId tName _ -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
|
||||
checkColumnTable :: [Table] -> FactColumn -> [ValidationError]
|
||||
checkColumnTable tables FactColumn {..} = case factColType of
|
||||
DimId {factColTargetTable = tName} -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
|
||||
_ -> []
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
# For more information, see: https://github.com/commercialhaskell/stack/blob/master/doc/yaml_configuration.md
|
||||
|
||||
# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
|
||||
resolver: lts-5.0
|
||||
resolver: lts-5.1
|
||||
|
||||
# Local packages, usually specified by relative directory name
|
||||
packages:
|
||||
|
|
|
|||
Loading…
Reference in New Issue