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