Adds SQL file generation to the executable

.gitignore

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

app/Main.hs

@@ -2,13 +2,20 @@ module Main where
 
 import qualified Data.Text as Text
 
-import Data.List   (nub)
+import Data.Char        (toLower)
-import System.Exit (exitFailure, exitSuccess)
+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
+        then mapM_ print errors              >> exitFailure
-        else do
+        else writeSQLFiles progOutputDir env >> exitSuccess
-          let dimTables  = map (\fact -> (fact, extractDimensionTables env fact)) facts
-              factTables = map (\fact -> (fact, extractFactTable env fact)) facts
 
-              dimTableDefnSQLs  = [ tabDefnSQL table | (fact, tabs)  <- dimTables
+writeSQLFiles :: FilePath -> Env -> IO ()
-                                                     , table <- tabs
+writeSQLFiles outputDir env@Env{..} = forM_ sqls $ \(sqlType, table, sql) -> do
-                                                     , table `notElem` tables ]
+  let dirName  = outputDir </> map toLower (show sqlType)
-              factTableDefnSQLs = [ tabDefnSQL table | (fact, table) <- factTables ]
+      fileName = dirName </> Text.unpack table <.> "sql"
-
+  createDirectoryIfMissing True dirName
-          mapM_ putStrLn dimTableDefnSQLs
+  writeFile fileName sql
-          mapM_ putStrLn factTableDefnSQLs
-
-          exitSuccess
   where
-    toSQL      = Text.unpack . flip Text.snoc ';'
+    dimTables  = map (\fact -> (fact, extractDimensionTables env fact)) envFacts
-    tabDefnSQL = unlines . map toSQL . tableDefnSQL
+    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

app/Ringo/InputParser.hs

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

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
+  ghc-options:         -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans -O2
-  default-extensions:  OverloadedStrings, RecordWildCards, ScopedTypeVariables,
+  default-extensions:  OverloadedStrings, RecordWildCards, ScopedTypeVariables, BangPatterns,
-                       BangPatterns, TupleSections, NamedFieldPuns, GeneralizedNewtypeDeriving,
+                       TupleSections
-                       DeriveDataTypeable
   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,
+  build-depends:       base                 >=4.7  && <5,
-                       text                 >=1.2 && <1.3,
+                       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,
+  default-extensions:  OverloadedStrings, RecordWildCards, ScopedTypeVariables, BangPatterns,
-                       BangPatterns, TupleSections, NamedFieldPuns, GeneralizedNewtypeDeriving,
+                       TupleSections
-                       DeriveDataTypeable
   default-language:    Haskell2010
 
 test-suite ringo-test