Adds SQL file generation to the executable

pull/1/head
Abhinav Sarkar 7 years ago
parent 4a5233a1a2
commit c3d3019cd3
  1. 1
      .gitignore
  2. 59
      app/Main.hs
  3. 7
      app/Ringo/InputParser.hs
  4. 23
      ringo.cabal

1
.gitignore vendored

@ -2,6 +2,7 @@ Tables.hs
tables.yaml
dist
cabal-dev
out
.DS_STORE
*.o
*.hi

@ -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 ]
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
dimTables = map (\fact -> (fact, extractDimensionTables env fact)) envFacts
factTables = map (\fact -> (fact, extractFactTable env fact)) envFacts
mapM_ putStrLn dimTableDefnSQLs
mapM_ putStrLn factTableDefnSQLs
dimTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table)
| (_, tabs) <- dimTables
, table <- tabs
, table `notElem` envTables ]
factTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table)
| (_, table) <- factTables ]
exitSuccess
where
toSQL = Text.unpack . flip Text.snoc ';'
tabDefnSQL = unlines . map toSQL . tableDefnSQL
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

@ -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…
Cancel
Save