Changes FactColumn to use GADTs for better type safety.

pull/1/head
Abhinav Sarkar 7 years ago
parent 8c3c4d801d
commit 0f4970d587
  1. 24
      app/Ringo/InputParser.hs
  2. 6
      ringo.cabal
  3. 29
      src/Ringo.hs
  4. 53
      src/Ringo/Extractor.hs
  5. 15
      src/Ringo/Extractor/Internal.hs
  6. 20
      src/Ringo/Generator/Create.hs
  7. 7
      src/Ringo/Generator/Internal.hs
  8. 4
      src/Ringo/Generator/Populate/Dimension.hs
  9. 151
      src/Ringo/Generator/Populate/Fact.hs
  10. 87
      src/Ringo/Types.hs
  11. 1
      src/Ringo/Utils.hs
  12. 26
      src/Ringo/Validator.hs
  13. 2
      stack.yaml

@ -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

@ -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,21 +33,22 @@ 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 ->
[ 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 ->
[ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
, notNullSourceColumnRename scName (cName <> settingAvgSumColumnSuffix)
]
FactCountDistinct _ cName -> [ Column cName "json" NotNull ]
_ -> []
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
@ -55,11 +57,12 @@ 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
_ -> Nothing
. 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 =
@ -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
_ -> Nothing
( 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]
_ -> 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 ]
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,61 +58,66 @@ LANGUAGE 'plpgsql' IMMUTABLE;
|]
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement]
factCountDistinctUpdateStmts
popMode fact groupByColPrefix ~Select {selSelectList = SelectList _ origSelectItems, ..} = do
Settings {..} <- asks envSettings
tables <- asks envTables
let countDistinctCols = [ col | col@(FactCountDistinct _ _) <- factColumns fact]
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) ->
let unqCol = cast (eqi fTableName (fromMaybe tablePKColName scName)) "text"
bucketSelectCols =
[ sia (binop "&" (app "hashtext" [ unqCol ])
(num . Text.pack . show $ bucketCount settingFactCountDistinctErrorRate - 1))
(nmc $ cName <> "_bnum")
, sia (binop "-"
(num "31")
(app "ilog2"
[ app "min" [ binop "&"
(app "hashtext" [ unqCol ])
(prefop "~" (parens (binop "<<" (num "1") (num "31"))))]]))
(nmc $ cName <> "_bhash")
]
groupByCols = map ppScalarExpr selGroupBy
selectList =
[ i | i@(SelectItem _ _ a) <- origSelectItems , a `elem` map nmc groupByCols ]
selectStmt =
makeSelect
{ selSelectList = sl $ selectList ++ bucketSelectCols
, selTref = selTref
, selWhere = binop "and" (postop "isnotnull" unqCol) <$> selWhere
, selGroupBy = selGroupBy ++ [ ei $ cName <> "_bnum" ]
}
aggSelectClause =
sia (app "json_object_agg" [ ei (cName <> "_bnum"), ei (cName <> "_bhash") ]) (nmc cName)
in update extFactTableName
[ (cName, eqi "xyz" cName) ]
[ subtrefa "xyz"
makeSelect
{ selSelectList = sl $ map (si . ei) groupByCols ++ [ aggSelectClause ]
, selTref = [ subtrefa "zyx" selectStmt ]
, selGroupBy = selGroupBy
} ] $
foldBinop "and"
[ binop "=" (eqi extFactTableName . fromJust . Text.stripPrefix groupByColPrefix $ col)
(eqi "xyz" col)
| col <- groupByCols ]
factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
Select {selSelectList = SelectList _ origSelectItems, ..} -> do
Settings {..} <- asks envSettings
tables <- asks envTables
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 $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of
FactCountDistinct {factColMaybeSourceColumn = scName} ->
let unqCol = cast (eqi fTableName (fromMaybe tablePKColName scName)) "text"
bucketSelectCols =
[ sia (binop "&" (app "hashtext" [ unqCol ])
(num . Text.pack . show $ bucketCount settingFactCountDistinctErrorRate - 1))
(nmc $ cName <> "_bnum")
, sia (binop "-"
(num "31")
(app "ilog2"
[ app "min" [ binop "&"
(app "hashtext" [ unqCol ])
(prefop "~" (parens (binop "<<" (num "1") (num "31"))))]]))
(nmc $ cName <> "_bhash")
]
groupByCols = map ppScalarExpr selGroupBy
selectList =
[ i | i@(SelectItem _ _ a) <- origSelectItems , a `elem` map nmc groupByCols ]
selectStmt =
makeSelect
{ selSelectList = sl $ selectList ++ bucketSelectCols
, selTref = selTref
, selWhere = binop "and" (postop "isnotnull" unqCol) <$> selWhere
, selGroupBy = selGroupBy ++ [ ei $ cName <> "_bnum" ]
}
aggSelectClause =
sia (app "json_object_agg" [ ei (cName <> "_bnum"), ei (cName <> "_bhash") ]) (nmc cName)
in Just $ update extFactTableName
[ (cName, eqi "xyz" cName) ]
[ subtrefa "xyz"
makeSelect
{ selSelectList = sl $ map (si . ei) groupByCols ++ [ aggSelectClause ]
, selTref = [ subtrefa "zyx" selectStmt ]
, selGroupBy = selGroupBy
} ] $
foldBinop "and"
[ binop "=" (eqi extFactTableName . fromJust . Text.stripPrefix groupByColPrefix $ col)
(eqi "xyz" col)
| col <- groupByCols ]
_ -> Nothing
_ -> return []
where
bucketCount :: Double -> Integer
bucketCount errorRate =
@ -143,21 +151,22 @@ 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)
]
FactCountDistinct _ cName -> [ (cName, cast (str "{}") "json", 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 =
@ -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)
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)
} 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 (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…
Cancel
Save