Moves SQL type defaults to input json from code.

app/Main.hs

@@ -24,9 +24,9 @@ main = do
   ProgArgs {..} <- parseArgs
   result        <- parseInput progInputFile
   case result of
-    Left err              -> putStrLn err >> exitFailure
+    Left err                        -> putStrLn err >> exitFailure
-    Right (tables, facts) -> do
+    Right (tables, facts, defaults) -> do
-      let env    = Env tables facts progSettings
+      let env    = Env tables facts progSettings defaults
       let errors = nub $ concatMap (validateTable env) tables ++ concatMap (validateFact env) facts
       if not $ null errors
         then mapM_ print errors           >> exitFailure

app/Ringo/InputParser.hs

@@ -68,15 +68,15 @@ instance FromJSON Fact where
                               <*> o .: "columns"
   parseJSON o          = fail $ "Cannot parse fact: " ++ show o
 
-data Input = Input [Table] [Fact] deriving (Eq, Show)
+data Input = Input [Table] [Fact] TypeDefaults deriving (Eq, Show)
 
 instance FromJSON Input where
-  parseJSON (Object o) = Input <$> o .: "tables" <*> o .: "facts"
+  parseJSON (Object o) = Input <$> o .: "tables" <*> o .: "facts" <*> o .: "defaults"
   parseJSON o          = fail $ "Cannot parse input: " ++ show o
 
-parseInput :: FilePath -> IO (Either String ([Table], [Fact]))
+parseInput :: FilePath -> IO (Either String ([Table], [Fact], TypeDefaults))
 parseInput file = do
   result <- decodeFileEither file
   return $ case result of
     Left pe                    -> Left $ prettyPrintParseException pe
-    Right (Input tables facts) -> Right (tables, facts)
+    Right (Input tables facts defaults) -> Right (tables, facts, defaults)

src/Ringo/Generator.hs

@@ -5,6 +5,7 @@ module Ringo.Generator
        , factTablePopulateSQL
        ) where
 
+import qualified Data.Map as Map
 import qualified Data.Text as Text
 
 #if MIN_VERSION_base(4,8,0)
@@ -77,33 +78,33 @@ dimColumnMapping dimPrefix fact dimTableName =
   [ (dimColumnName dName cName, cName)
     | DimVal dName cName <- factColumns fact , dimPrefix <> dName == dimTableName]
 
-coalesceColumn :: TableName -> Column -> Text
+coalesceColumn :: TypeDefaults -> TableName -> Column -> Text
-coalesceColumn tName Column{..} =
+coalesceColumn defaults tName Column{..} =
   if columnNullable == Null
     then "coalesce(" <> fqColName <> "," <> defVal columnType <> ")"
     else fqColName
   where
     fqColName = fullColName tName columnName
 
-    defVal colType
+    defVal colType =
-     | "integer" `Text.isPrefixOf` colType = "-42"
+      fromMaybe (error $ "Default value not known for column type: " ++ Text.unpack colType)
-     | "timestamp" `Text.isPrefixOf` colType = "'00-00-00 00:00:00'"
+      . fmap snd
-     | "character" `Text.isPrefixOf` colType = "'XXX_UNKNOWN_'"
+      . find (\(k, _) -> k `Text.isPrefixOf` colType)
-     | "uuid" `Text.isPrefixOf` colType = "'00000000-0000-0000-0000-000000000000'::uuid"
+      . Map.toList
-     | "boolean" `Text.isPrefixOf` colType = "false"
+      $ defaults
-     | otherwise = error $ "Unknown column type: " ++ Text.unpack colType
 
 dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text
 dimensionTablePopulateSQL popMode fact dimTableName = do
   dimPrefix           <- settingDimPrefix <$> asks envSettings
   tables              <- asks envTables
+  defaults            <- asks envTypeDefaults
   let factTable       = fromJust $ findTable (factTableName fact) tables
       colMapping      = dimColumnMapping dimPrefix fact dimTableName
       baseSelectC     = "SELECT DISTINCT\n"
                           <> joinColumnNames
                               (map (\(_, cName) ->
                                      let col = fromJust . findColumn cName $ tableColumns factTable
-                                     in coalesceColumn (factTableName fact) col <> " AS " <> cName)
+                                     in coalesceColumn defaults (factTableName fact) col <> " AS " <> cName)
                                    colMapping)
                           <> "\n"
                           <> "FROM " <> factTableName fact
@@ -139,6 +140,7 @@ factTablePopulateSQL popMode fact = do
   Settings {..}      <- asks envSettings
   allDims            <- extractAllDimensionTables fact
   tables             <- asks envTables
+  defaults           <- asks envTypeDefaults
   let fTableName     = factTableName fact
       fTable         = fromJust . findTable fTableName $ tables
       dimIdColName   = settingDimTableIdColumnName
@@ -156,7 +158,7 @@ factTablePopulateSQL popMode fact = do
         DimTime cName             -> [ timeUnitColumnInsertSQL cName ]
         NoDimId cName             ->
           let sCol = fromJust . findColumn cName $ tableColumns fTable
-          in [ (cName, coalesceColumn fTableName sCol, True) ]
+          in [ (cName, coalesceColumn defaults fTableName sCol, True) ]
         FactCount scName cName    ->
           [ (cName, "count(" <> maybe "*" (fullColName fTableName) scName <> ")", False) ]
         FactSum scName cName      ->
@@ -184,7 +186,7 @@ factTablePopulateSQL popMode fact = do
                      $ fullColName factSourceTableName colName
               else let
                   dimLookupWhereClauses =
-                    [ fullColName tableName c1 <> " = " <> coalesceColumn factSourceTableName col2
+                    [ fullColName tableName c1 <> " = " <> coalesceColumn defaults factSourceTableName col2
                       | (c1, c2) <- dimColumnMapping settingDimPrefix dimFact tableName
                       , let col2 = fromJust . findColumn c2 $ tableColumns factSourceTable ]
                 in "SELECT " <> dimIdColName <> " FROM " <> tableName <> "\nWHERE "

src/Ringo/Types.hs

@@ -101,17 +101,21 @@ defSettings = Settings
               , settingDimensionJSONFileName      = "dimensions.json"
               }
 
-data ValidationError = MissingTable      !TableName
+data ValidationError = MissingTable             !TableName
-                     | MissingFact       !TableName
+                     | MissingFact              !TableName
-                     | MissingColumn     !TableName !ColumnName
+                     | MissingColumn            !TableName !ColumnName
-                     | MissingTimeColumn !TableName
+                     | MissingTimeColumn        !TableName
-                     | NullableColumn    !TableName !ColumnName
+                     | MissingNotNullConstraint !TableName !ColumnName
+                     | MissingTypeDefault       !Text
                      deriving (Eq, Show)
 
+type TypeDefaults = Map Text Text
+
 data Env = Env
-           { envTables   :: ![Table]
+           { envTables       :: ![Table]
-           , envFacts    :: ![Fact]
+           , envFacts        :: ![Fact]
-           , envSettings :: !Settings
+           , envSettings     :: !Settings
+           , envTypeDefaults :: !TypeDefaults
            } deriving (Eq, Show)
 
 data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)

src/Ringo/Validator.hs

@@ -3,6 +3,9 @@ module Ringo.Validator
        , validateFact
        ) where
 
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+
 #if MIN_VERSION_base(4,8,0)
 #else
 import Control.Applicative ((<$>))
@@ -21,8 +24,13 @@ checkTableForCol tab colName =
 
 validateTable :: Table -> Reader Env [ValidationError]
 validateTable table = do
-  tables <- asks envTables
+  tables   <- asks envTables
-  return . concatMap (checkConstraint tables) . tableConstraints $ table
+  defaults <- Map.keys <$> asks envTypeDefaults
+  let constVs       = concatMap (checkConstraint tables) . tableConstraints $ table
+      typeDefaultVs = [ MissingTypeDefault cType
+                        | Column _ cType _ <- tableColumns table
+                        , null . filter (`Text.isPrefixOf` cType) $ defaults]
+  return $ constVs ++ typeDefaultVs
   where
     checkConstraint _ (PrimaryKey colName)    = checkTableForCol table colName
     checkConstraint _ (UniqueKey columnNames) = checkTableForColRefs table columnNames
@@ -45,7 +53,7 @@ validateFact Fact {..} = do
       let colVs  = concatMap (checkColumn tables table) factColumns
       let timeVs = [ MissingTimeColumn factTableName
                      | null [ c | DimTime c <- factColumns ] ]
-      let notNullVs = [ NullableColumn factTableName c
+      let notNullVs = [ MissingNotNullConstraint factTableName c
                         | DimTime c <- factColumns
                         , let col = findColumn c (tableColumns table)
                         , isJust col