Refactoring

pull/1/head
Abhinav Sarkar 7 years ago
parent f016f0de09
commit c39916704e
  1. 10
      src/Ringo/Extractor.hs
  2. 32
      src/Ringo/Extractor/Internal.hs
  3. 32
      src/Ringo/Generator.hs
  4. 14
      src/Ringo/Validator.hs

@ -1,5 +1,6 @@
module Ringo.Extractor
( extractDimensions
( extractDimensionTables
, extractAllDimensionTables
, extractFactTable
) where
@ -13,10 +14,11 @@ import Ringo.Extractor.Internal
import Ringo.Types
import Ringo.Utils
extractFactTable :: Fact -> Table -> Reader Env Table
extractFactTable fact table = do
extractFactTable :: Fact -> Reader Env Table
extractFactTable fact = do
Settings {..} <- asks envSettings
allDims <- extractAllDimensions fact table
allDims <- extractAllDimensionTables fact
table <- asks $ fromJust . findTable (factTableName fact) . envTables
let intType = "integer"
sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table

@ -11,18 +11,23 @@ import Data.List (nub)
import Ringo.Types
import Ringo.Utils
extractDimensions :: Fact -> Table -> Reader Env [Table]
extractDimensions fact Table {..} = do
tables <- asks envTables
prefix <- settingDimPrefix <$> asks envSettings
return $ dimsFromIds tables ++ dimsFromVals prefix
dimColumnName :: Text.Text -> ColumnName -> ColumnName
dimColumnName dimName columnName =
fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
extractDimensionTables :: Fact -> Reader Env [Table]
extractDimensionTables fact = do
tables <- asks envTables
prefix <- settingDimPrefix <$> asks envSettings
let table = fromJust . findTable (factTableName fact) $ tables
return $ dimsFromIds tables ++ dimsFromVals prefix (tableColumns table)
where
dimsFromIds tables =
flip mapMaybe (factColumns fact) $ \fcol -> case fcol of
DimId d _ -> findTable d tables
_ -> Nothing
dimsFromVals prefix =
dimsFromVals prefix tableColumns =
map (\(dim, cols) -> Table { tableName = prefix <> dim
, tableColumns = Column "id" "serial" NotNull : cols
, tableConstraints = [ PrimaryKey "id"
@ -42,19 +47,12 @@ extractDimensions fact Table {..} = do
. factColumns
$ fact
dimColumnName :: Text.Text -> ColumnName -> ColumnName
dimColumnName dimName columnName =
fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
extractAllDimensions :: Fact -> Table -> Reader Env [Table]
extractAllDimensions fact table = do
myDims <- extractDimensions fact table
extractAllDimensionTables :: Fact -> Reader Env [Table]
extractAllDimensionTables fact = do
myDims <- extractDimensionTables fact
parentDims <- concat <$> mapM extract (factParentNames fact)
return . nub $ myDims ++ parentDims
where
extract fName = do
tables <- asks envTables
facts <- asks envFacts
let pFact = fromJust . findFact fName $ facts
pFactTable = fromJust . findTable (factTableName pFact) $ tables
extractAllDimensions pFact pFactTable
extractAllDimensionTables . fromJust . findFact fName $ facts

@ -5,10 +5,11 @@ module Ringo.Generator
import qualified Data.Text as Text
import Data.List (intersperse)
import Data.Maybe (mapMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import Control.Monad.Reader (Reader, asks)
import Data.List (intersperse)
import Data.Maybe (mapMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import Ringo.Extractor.Internal
import Ringo.Types
@ -42,13 +43,16 @@ tableDefnSQL Table {..} =
<> (Text.concat . intersperse ",\n" . map columnDefnSQL $ tableColumns)
<> "\n)"
dimensionTableInsertSQL :: Text -> Fact -> TableName -> Text
dimensionTableInsertSQL dimPrefix fact dimTableName = let
colMapping = flip mapMaybe (factColumns fact) $ \fCol -> case fCol of
DimVal dName cName | dimPrefix <> dName == dimTableName -> Just (dimColumnName dName cName, cName)
_ -> Nothing
in "INSERT INTO " <> dimTableName <> " (\n"
<> colNamesString (map fst colMapping)
<> "\n) SELECT DISTINCT \n"
<> colNamesString (map snd colMapping)
<> "\nFROM " <> factTableName fact
dimensionTableInsertSQL :: Fact -> TableName -> Reader Env Text
dimensionTableInsertSQL fact dimTableName = do
dimPrefix <- settingDimPrefix <$> asks envSettings
let colMapping = flip mapMaybe (factColumns fact) $ \fCol -> case fCol of
DimVal dName cName | dimPrefix <> dName == dimTableName ->
Just (dimColumnName dName cName, cName)
_ -> Nothing
return $ "INSERT INTO " <> dimTableName <> " (\n"
<> colNamesString (map fst colMapping)
<> "\n) SELECT DISTINCT \n"
<> colNamesString (map snd colMapping)
<> "\nFROM " <> factTableName fact

@ -1,8 +1,10 @@
module Ringo.Validator where
module Ringo.Validator
( validateTable
, validateFact
, withFactValidation
) where
import Control.Monad.Reader (Reader, asks)
import Data.Maybe (mapMaybe, fromMaybe, fromJust)
import Data.Monoid ((<>))
import Ringo.Types
import Ringo.Utils
@ -46,11 +48,9 @@ validateFact Fact {..} = do
checkColumn table = maybe [] (checkTableForCol table) . factColumnName
withFactValidation :: Fact -> (Table -> Reader Env a)
-> Reader Env (Either [ValidationError] a)
withFactValidation :: Fact -> Reader Env a -> Reader Env (Either [ValidationError] a)
withFactValidation fact func = do
tables <- asks envTables
errors <- validateFact fact
if not $ null errors
then return $ Left errors
else fmap Right . func . fromJust . findTable (factTableName fact) $ tables
else fmap Right func

Loading…
Cancel
Save