content: 
  This file is a confused mess. The plan is to completely start again,
  to produce a big multi function routine which analyzes sql:
  
  * check it parses
  * lists type errors
  * produces documentation
  * catalog reference docs - so we can search an index, then click to go
    to definition in the rendered docs
  * check the roundtripping, etc.
  
  This will be mostly based on the runtestbattery function below.
  
  > {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables,FlexibleContexts,QuasiQuotes #-}
  > module Database.HsSqlPpp.Utils.RoundTripTester
  >     (roundTripTest
  >     ,RoundTripResults(..)
  >     ,TypeErrorList
  >     ,rtShowBrief) where
  >
  > import System.Console.CmdArgs
  > --import System.IO
  > import Control.Monad.Error
  > import Data.List
  
  > --import Debug.Trace
  > import Data.Maybe
  > import Data.Generics.Uniplate.Data
  >
  > --import Database.HsSqlPpp.Tests.Tests
  > import Database.HsSqlPpp.Utils.Utils
  > --import Database.HsSqlPpp.Utils.Here
  >
  > import Database.HsSqlPpp.Ast
  > import Database.HsSqlPpp.Catalog
  > import Database.HsSqlPpp.TypeChecker
  > import Database.HsSqlPpp.Annotation
  > import Database.HsSqlPpp.SqlTypes
  >
  > import Database.HsSqlPpp.Parser
  > --import Database.HsSqlPpp.Parsing.Lexer
  >
  > import Database.HsSqlPpp.PrettyPrinter
  >
  > --import Database.HsSqlPpp.Examples.AnnotateSource
  >
  > --import Database.HsSqlPpp.DatabaseLoader.DatabaseLoader
  > --import Database.HsSqlPpp.Examples.WrapperGen
  > import Database.HsSqlPpp.Utils.DBUtils
  >
  > --import Database.HsSqlPpp.DevelTools.MakeWebsite
  > --import Database.HsSqlPpp.DevelTools.MakeAntiNodes
  > --import Database.HsSqlPpp.Examples.Extensions.TransitionConstraints
  > --import Database.HsSqlPpp.Examples.Extensions.ChaosExtensions
  > --import Database.HsSqlPpp.Examples.Chaos2010
  
  > type TypeErrorList = [(Maybe (String,Int,Int), [TypeError])]
  
  > data RoundTripResults = RoundTripResults
  >     {rtDatabaseName :: String
  >     ,rtFiles :: [FilePath]
  >     ,rtEmptyCat :: Catalog
  >     ,rtOrigCat :: Catalog
  >     ,rtOrigAst :: [Statement]
  >     ,rtOrigTypeErrors :: TypeErrorList
  >     ,rtPgCat :: Catalog
  >     ,rtOrigPgCatDiff :: CatalogDiff
  >     ,rtDumpAst :: [Statement]
  >     ,rtDumpCat :: Catalog
  >     ,rtDumpTypeErrors :: TypeErrorList
  >     ,rtOrigDumpCatDiff :: CatalogDiff
  >     }
  
  > rtShowBrief :: RoundTripResults -> String
  > rtShowBrief rtt =
  >   header "initial type errors"
  >   ++ intercalate "\n" (ppTypeErrors (rtOrigTypeErrors rtt))
  >   ++ header "cat diff: orig to pg"
  >   ++ ppCatDiff (rtOrigPgCatDiff rtt)
  >   ++ header "dump type errors"
  >   ++ intercalate "\n" (ppTypeErrors (rtDumpTypeErrors rtt))
  >   ++ header "cat diff: orig to dump"
  >   ++ ppCatDiff (rtOrigDumpCatDiff rtt)
  >   where
  >     header x = "-------------" ++ x ++ "\n"
  
  > {-ppCatalogA = mode $ PPCatalog {database = def
  >                               ,files = def &= typ "FILES" & args}
  >              &= text "reads each file, parses, type checks, then outputs the \
  >                      \changes to the catalog that the sql makes"
  >
  > ppCatalog :: String -> [FilePath] -> IO ()
  > ppCatalog db fns = wrapETs $ do
  >   scat <- liftIO (readCatalog db) >>= tsl
  >   (ncat, _) <- mapM (\f -> (liftIO . readInput) f >>=
  >                            tsl . P.parseSql f) fns >>=
  >                  return . (concat |>
  >                            astTransformer |>
  >                            A.typeCheck scat)
  >   liftIO $ putStrLn $ ppCatDiff $ compareCatalogs scat emptyCatalog ncat
  
  -------------------------------------------------------------------------------
  
  load
  ====
  
  load sql files into a database via parsing and pretty printing them
  
  >
  > loadSql :: String -> [String] -> IO ()
  > loadSql db fns = wrapETs $
  >      liftIO (hSetBuffering stdout NoBuffering) >>
  >      mapM (\f -> (liftIO . readInput) f >>=
  >                  tsl . P.parseSql f) fns >>=
  >      return . (concat |>
  >                astTransformer) >>=
  >      liftIO . loadAst db
  
  -------------------------------------------------------------------------------
  
  loadPsql
  ========
  
  load sql files into a database via psql
  
  > loadPsqlA = mode $ LoadPsql {database = def
  >                             ,files = def &= typ "FILES" & args}
  >             &= text "loads sql into a database using psql."
  >
  > loadSqlPsql :: String -> [String] -> IO ()
  > loadSqlPsql db = wrapETs .
  >   mapM_ (\s -> liftIO (loadSqlUsingPsqlFromFile db s) >>=
  >                tsl >>=
  >                liftIO . putStrLn)
  
  
  -------------------------------------------------------------------------------
  
  clearLoad
  =========
  
  like load above, but runs the clear command first
  
  might try to work out a way of running multiple commands in one invoc
  of this exe, then this command will disappear
  
  > clearLoadA = mode $ ClearLoad {database = def
  >                               ,files = def &= typ "FILES" & args}
  >              &= text "cleardb then loadsql"
  >
  > clearAndLoadSql :: String -> [String] -> IO ()
  > clearAndLoadSql db fns = cleardb db >> loadSql db fns -}
  
  
  -------------------------------------------------------------------------------
  
  testBattery
  ===========
  
  run test battery: run a bunch of tests including consistency on the
  database and sql files given
  
  The idea is to typecheck the sql, load it into pg and dump it via psql
  and via database loader, can then compare asts, catalogs, etc. in a
  lot of different ways
  
  currently:
  parse and type check sql, save the catalog
  load the sql into the db using psql, compare the catalog read from pg
  with the catalog from typechecking
  dump the sql and typecheck the dump, compare the catalog from this
  check with the catalog from the original typecheck
  
  todo: compare asts from initial parse with parsed dump - this is going
  to be a lot of work to get passing since the statements are
  re-ordered, and sometimes changed/ split up by pg
  
  also: load the sql using the extension system and database loader,
  then compare pg catalog with initial catalog, and dump and compare ast
  with original ast
  
  want to run a similar set of tests starting with the dump sql:
  get ast,cat from dump sql, load using psql and using databaseloader
  and check cats and subsequent dump asts.
  
  getting the dump ast comparing with the original ast:
  
  step one: convert tests in parser test to also roundtrip through
  database, see parsertests for details
  
  step two: write an ast conversion routine: assume that the pgdump ast
  is like the ast fed into pg but with a few statements split into
  components (e.g. create table with serial is split into create
  sequence and create table), and then the statements are reordered, so
  write a routine to mirror this - will then have
  (anyast -> rearrange and reorder) == (anyast -> pg->pgdump)
  
  
  rough new plan:
  
  combine this with the planned report generator
  
  have new annotation routine used in website, in annotatesource2
  first part is to run this and produce html report of the source,
  then add the catalog summary page, and list of type errors as with the website generator
  
  then we do the round trip tests:
  load into database, then compare catalogs
  dump from database, reparse and compare catalogs
  then parse, typecheck the dumped code, list type errors and catalog differences
  when the code is up to it, compare the original ast to the dumped ast.
  
  make different stages optional:
  
  run as a check tool, just want the catalog differences and type errors
  on the command line. would be nice to try and link the catalog
  differences to source positions.
  
  do website generation, without the pg roundtrips
  
  > parseFiles :: [String] -> IO [StatementList]
  > parseFiles fns = do
  >   as <- mapM (\f -> fmap (parseStatements f) $ readFile f) fns
  >   return $ either (error . show) id $ sequence as
  
  > roundTripTest :: ([Statement] -> [Statement]) -> String -> [FilePath] -> IO RoundTripResults
  > roundTripTest astTransformer dbName fns = wrapETs $ do
  >     -- clear target database
  >     liftIO $ clearDBN dbName
  >     -- get the catalog of the empty database
  >     emptyCat <- readCat dbName
  >     -- get the ast and catalog of the sql to test with the catalog
  >     -- determined by the hssqlppp typechecker
  >     (origAst :: [Statement]) <- (astTransformer . concat) `fmap` liftIO (parseFiles fns)
  >     let (origCat :: Catalog, origAast :: [Statement]) = typeCheckStatements emptyCat origAst
  >     let origTypeErrors = getTypeErrors origAast
  >     -- load the test sql into postgresql using psql and get the
  >     -- new catalog from postgresql
  >     _ <- liftIO $ loadSqlUsingPsql dbName $ printStatements origAst
  >     pgCat <- readCat dbName
  >     -- show the differences between the catalog as determined by the
  >     -- hssqlppp type checker and by loading into postgresql and reading
  >     -- the catalog from the loaded database
  >     let origPgCatDiff = compareCatalogs emptyCat origCat pgCat
  >     -- dump the database from postgresql, parse and run the dump sql through the
  >     -- hssqlppp type checker
  >     dumpSql <- liftIO $ pgDump dbName
  >     dumpSqlAst <- etsr $ parseStatements "" dumpSql
  >     let (dumpCat,dumpAast) = typeCheckStatements emptyCat dumpSqlAst
  >     let dumpTypeErrors = getTypeErrors dumpAast
  >     let origDumpCatDiff = compareCatalogs emptyCat origCat dumpCat
  >
  >     return $ RoundTripResults
  >                {rtDatabaseName = dbName
  >                ,rtFiles = fns
  >                ,rtEmptyCat = emptyCat
  >                ,rtOrigCat = origCat
  >                ,rtOrigAst = origAast
  >                ,rtOrigTypeErrors = origTypeErrors
  >                ,rtPgCat = pgCat
  >                ,rtOrigPgCatDiff = origPgCatDiff
  >                ,rtDumpAst = dumpAast
  >                ,rtDumpCat = dumpCat
  >                ,rtDumpTypeErrors = dumpTypeErrors
  >                ,rtOrigDumpCatDiff = origDumpCatDiff
  >                }
  >     where
  >       readCat d = liftIO (readCatalog d) >>= etsr
  
  > -- | Pretty print list of type errors with optional source position
  > --   in emacs readable format.
  > ppTypeErrors :: [(Maybe (String,Int,Int), [TypeError])] -> [String]
  > ppTypeErrors tes =
  >   map showSpTe tes
  >   where
  >     showSpTe (Just (fn,l,c), e) =
  >         fn ++ ":" ++ show l ++ ":" ++ show c ++ ":\n" ++ show e
  >     showSpTe (_,e) = "unknown:0:0:\n" ++ show e
  
  > getTypeErrors :: Data a => a -> [(Maybe (String,Int,Int), [TypeError])]
  > getTypeErrors es =
  >   let as = [(a::Annotation) | a <- universeBi es]
  >   in mapMaybe getTes as
  >   where
  >     getTes as = let tes = errs as
  >                 in if null tes
  >                    then Nothing
  >                    else Just (asrc as, tes)
  
  > type ErrorIO e a = ErrorT e IO a
  
  > etsr :: Show e => Either e a -> ErrorIO String a
  > etsr = either (throwError . show) return
  