Adds SQL file generation to the executable
parent
4a5233a1a2
commit
c3d3019cd3
|
@ -2,6 +2,7 @@ Tables.hs
|
|||
tables.yaml
|
||||
dist
|
||||
cabal-dev
|
||||
out
|
||||
.DS_STORE
|
||||
*.o
|
||||
*.hi
|
||||
|
|
61
app/Main.hs
61
app/Main.hs
|
@ -2,13 +2,20 @@ module Main where
|
|||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Data.List (nub)
|
||||
import System.Exit (exitFailure, exitSuccess)
|
||||
import Data.Char (toLower)
|
||||
import Data.List (nub)
|
||||
import Data.Monoid ((<>))
|
||||
import Control.Monad (forM_)
|
||||
import System.Directory (createDirectoryIfMissing)
|
||||
import System.FilePath ((</>), (<.>))
|
||||
import System.Exit (exitFailure, exitSuccess)
|
||||
|
||||
import Ringo
|
||||
import Ringo.ArgParser
|
||||
import Ringo.InputParser
|
||||
|
||||
data SQLType = Create | Populate | Update deriving (Eq, Show)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
ProgArgs {..} <- parseArgs
|
||||
|
@ -19,21 +26,41 @@ main = do
|
|||
let env = Env tables facts progSettings
|
||||
let errors = nub $ concatMap (validateTable env) tables ++ concatMap (validateFact env) facts
|
||||
if not $ null errors
|
||||
then mapM print errors >> exitFailure
|
||||
else do
|
||||
let dimTables = map (\fact -> (fact, extractDimensionTables env fact)) facts
|
||||
factTables = map (\fact -> (fact, extractFactTable env fact)) facts
|
||||
then mapM_ print errors >> exitFailure
|
||||
else writeSQLFiles progOutputDir env >> exitSuccess
|
||||
|
||||
dimTableDefnSQLs = [ tabDefnSQL table | (fact, tabs) <- dimTables
|
||||
, table <- tabs
|
||||
, table `notElem` tables ]
|
||||
factTableDefnSQLs = [ tabDefnSQL table | (fact, table) <- factTables ]
|
||||
|
||||
mapM_ putStrLn dimTableDefnSQLs
|
||||
mapM_ putStrLn factTableDefnSQLs
|
||||
|
||||
exitSuccess
|
||||
writeSQLFiles :: FilePath -> Env -> IO ()
|
||||
writeSQLFiles outputDir env@Env{..} = forM_ sqls $ \(sqlType, table, sql) -> do
|
||||
let dirName = outputDir </> map toLower (show sqlType)
|
||||
fileName = dirName </> Text.unpack table <.> "sql"
|
||||
createDirectoryIfMissing True dirName
|
||||
writeFile fileName sql
|
||||
where
|
||||
toSQL = Text.unpack . flip Text.snoc ';'
|
||||
tabDefnSQL = unlines . map toSQL . tableDefnSQL
|
||||
dimTables = map (\fact -> (fact, extractDimensionTables env fact)) envFacts
|
||||
factTables = map (\fact -> (fact, extractFactTable env fact)) envFacts
|
||||
|
||||
dimTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table)
|
||||
| (_, tabs) <- dimTables
|
||||
, table <- tabs
|
||||
, table `notElem` envTables ]
|
||||
factTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table)
|
||||
| (_, table) <- factTables ]
|
||||
|
||||
dimTableInsertSQLs = [ (Populate
|
||||
, tableName table
|
||||
, sqlStr $ dimensionTableInsertSQL env fact (tableName table))
|
||||
| (fact, tabs) <- dimTables
|
||||
, table <- tabs
|
||||
, table `notElem` envTables ]
|
||||
|
||||
fctTableInsertSQLs = [ (Populate, tableName table, sqlStr $ factTableInsertSQL env fact)
|
||||
| (fact, table) <- factTables ]
|
||||
|
||||
sqls = concat [ dimTableDefnSQLs
|
||||
, factTableDefnSQLs
|
||||
, dimTableInsertSQLs
|
||||
, fctTableInsertSQLs
|
||||
]
|
||||
|
||||
sqlStr s = Text.unpack $ s <> ";\n"
|
||||
tabDefnSQL = unlines . map sqlStr . tableDefnSQL
|
||||
|
|
|
@ -3,9 +3,10 @@ module Ringo.InputParser (parseInput) where
|
|||
import qualified Data.Text as Text
|
||||
import qualified Data.Vector as V
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Vector ((!), (!?))
|
||||
import Data.Yaml hiding (Null)
|
||||
import Data.Vector ((!), (!?))
|
||||
|
||||
import Ringo.Types
|
||||
|
||||
instance FromJSON Nullable where
|
||||
|
@ -17,7 +18,7 @@ instance FromJSON Nullable where
|
|||
|
||||
instance FromJSON Column where
|
||||
parseJSON (Array a) = if V.length a < 2
|
||||
then fail $ "Column needs at least two elements: name and type"
|
||||
then fail "Column needs at least two elements: name and type"
|
||||
else do
|
||||
cName <- parseJSON $ a ! 0
|
||||
cType <- parseJSON $ a ! 1
|
||||
|
|
23
ringo.cabal
23
ringo.cabal
|
@ -1,6 +1,6 @@
|
|||
name: ringo
|
||||
version: 0.1.0.0
|
||||
synopsis: Tool to transform OLTP database schemas to OLAP database star schemas automatically
|
||||
synopsis: Tool to transform OLTP schemas to OLAP star schemas automatically
|
||||
description: Please see README.md
|
||||
homepage: http://github.com/quintype/ringo#readme
|
||||
license: MIT
|
||||
|
@ -22,15 +22,13 @@ library
|
|||
Ringo.Types
|
||||
other-modules: Ringo.Extractor.Internal,
|
||||
Ringo.Utils
|
||||
|
||||
build-depends: base >=4.7 && <5,
|
||||
text >=1.2 && <1.3,
|
||||
containers >=0.5 && <0.6,
|
||||
mtl >=2.2 && <2.3
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans
|
||||
default-extensions: OverloadedStrings, RecordWildCards, ScopedTypeVariables,
|
||||
BangPatterns, TupleSections, NamedFieldPuns, GeneralizedNewtypeDeriving,
|
||||
DeriveDataTypeable
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans -O2
|
||||
default-extensions: OverloadedStrings, RecordWildCards, ScopedTypeVariables, BangPatterns,
|
||||
TupleSections
|
||||
default-language: Haskell2010
|
||||
|
||||
executable ringo
|
||||
|
@ -38,16 +36,17 @@ executable ringo
|
|||
other-modules: Ringo.ArgParser,
|
||||
Ringo.InputParser
|
||||
main-is: Main.hs
|
||||
build-depends: base >=4.7 && <5,
|
||||
text >=1.2 && <1.3,
|
||||
build-depends: base >=4.7 && <5,
|
||||
text >=1.2 && <1.3,
|
||||
optparse-applicative >=0.11 && <0.12,
|
||||
yaml >=0.8 && <0.9,
|
||||
yaml >=0.8 && <0.9,
|
||||
vector >=0.10 && <0.11,
|
||||
directory >=1.2 && <1.3,
|
||||
filepath >=1.4 && <1.5,
|
||||
ringo
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans -O2
|
||||
default-extensions: OverloadedStrings, RecordWildCards, ScopedTypeVariables,
|
||||
BangPatterns, TupleSections, NamedFieldPuns, GeneralizedNewtypeDeriving,
|
||||
DeriveDataTypeable
|
||||
default-extensions: OverloadedStrings, RecordWildCards, ScopedTypeVariables, BangPatterns,
|
||||
TupleSections
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite ringo-test
|
||||
|
|
Loading…
Reference in New Issue