Spec.hs

{-# LANGUAGE TemplateHaskell #-}
import VerifySchema
import Hasql.Connection
import System.Environment (getArgs, lookupEnv, getEnvironment)
import qualified Data.ByteString.Char8 as BS
import Kea.Model

import GetSchemas
import Data.Maybe (maybeToList)

import Data.List (intercalate)
import Control.Exception (throwIO)


verifiers :: [ReaderT CheckEnv (Accum CheckResults) ()]
verifiers = $(do
    schemas <- runIO getKeaModelSchemas 
    let exps = map (\sch -> [| verifySchema $(varE $ mkName sch)|] ) schemas
    listE exps)

renderLabelWithContext :: String -> [String] -> String -> String
renderLabelWithContext label ctx msg 
    = label ++ " (" ++ intercalate "." ctx ++ "): " ++ msg

printWarning :: Warning -> IO ()
printWarning warn = putStrLn $ renderLabelWithContext "Warning" warn.ctx warn.warning

printError :: Error -> IO ()
printError err = putStrLn $ renderLabelWithContext "Error" err.ctx err.error

printResults :: CheckResults -> IO ()
printResults res = do
    mapM_ printWarning res.warnings
    mapM_ printError res.errors

main :: IO ()
main = do
    args <- getArgs
    maybeConn <- acquire . BS.pack $ unwords args
    conn <- case maybeConn of
        Right conn -> return conn
        Left err -> fail (show err)
    env <- fetchCheckEnv conn
    let results = execAccum (runReaderT (sequence verifiers) env) mempty
    printResults results