content: -----------------------------------------------------------
  -- |
  -- Module      :  PrintQuery.hs
  -- Copyright   :  haskelldb-users@lists.sourceforge.net
  -- License     :  BSD-style
  -- 
  -- Maintainer  :  haskelldb-users@lists.sourceforge.net
  -- Stability   :  experimental
  -- Portability :  non portable
  -- Author      :  Justin Bailey (jgbailey AT gmail DOT com)
  -- Pretty printing for Query, PrimQuery, and SqlSelect values.
  -- Useful for debugging the library.
  -- 
  -----------------------------------------------------------
  module Database.HaskellDB.PrintQuery 
      (ppQuery, ppQueryUnOpt
      , ppSelect, ppSelectUnOpt, ppSqlSelect, ppPrim
      , Database.HaskellDB.PrintQuery.ppSql, Database.HaskellDB.PrintQuery.ppSqlUnOpt)
  
  where
  
  import Prelude hiding ((<>))
  import Database.HaskellDB.PrimQuery
  import Database.HaskellDB.Sql
  import Database.HaskellDB.Query (Query, runQuery, Rel)
  import Database.HaskellDB.Optimize (optimize)
  import Database.HaskellDB.Sql.Generate (sqlQuery)
  import Database.HaskellDB.Sql.Default (defaultSqlGenerator)
  import Database.HaskellDB.Sql.Print as Sql (ppSql)
  import Text.PrettyPrint.HughesPJ
  
  -- | Take a query, turn it into a SqlSelect and print it.
  ppSql :: Query (Rel r) -> Doc
  ppSql qry = Sql.ppSql . sqlQuery defaultSqlGenerator . optimize $ runQuery qry
  
  -- | Take a query, turn it into a SqlSelect and print it.
  ppSqlUnOpt :: Query (Rel r) -> Doc
  ppSqlUnOpt qry = Sql.ppSql . sqlQuery defaultSqlGenerator $ runQuery qry
  
  -- | Take a query, turn it into a SqlSelect and print it.
  ppSelect :: Query (Rel r) -> Doc
  ppSelect qry = ppPQ (sqlQuery defaultSqlGenerator) optimize (runQuery $ qry)
  
  -- | Take a query, turn it into a SqlSelect and print it, with optimizations.
  ppSelectUnOpt :: Query (Rel r) -> Doc
  ppSelectUnOpt qry = ppPQ (sqlQuery defaultSqlGenerator) id (runQuery $ qry)
  
  -- | Optimize the query and pretty print the primitive representation.
  ppQuery :: Query (Rel r) -> Doc
  ppQuery qry = ppPrimF optimize (runQuery $ qry)
  
  -- | Pretty print the primitive representation of an unoptimized query.
  ppQueryUnOpt :: Query (Rel r) -> Doc
  ppQueryUnOpt qry = ppPrimF id (runQuery $ qry)
  
  -- | Pretty print a PrimQuery value.
  ppPrim :: PrimQuery -> Doc
  ppPrim = ppPrimF id
  
  -- | Transform a PrimQuery according to the function given, then
  -- pretty print it.
  ppPrimF :: (PrimQuery -> PrimQuery) -- ^ Transformation function to apply to PrimQuery first.
    -> PrimQuery -- ^ PrimQuery to print.
    -> Doc
  ppPrimF f qry = ppPrimF' (f qry)
    where
      ppPrimF' (BaseTable tableName scheme) =
        hang (text "BaseTable" <> colon <+> text tableName)
          nesting
          (brackets (fsep $ punctuate comma (map text scheme)))
      ppPrimF' (Project assoc primQuery) =
        hang (text "Project")
          nesting (brackets (ppAssoc assoc) $+$
          parens (ppPrimF' primQuery))   
      ppPrimF' (Restrict primExpr primQuery) =
        hang (text "Restrict")
          nesting
          (ppExpr primExpr $+$ ppPrimF' primQuery)
      ppPrimF' (Group assoc primQuery) =
        hang (text "Group")
          nesting
          (brackets (ppAssoc assoc) $+$
              parens (ppPrimF' primQuery))
      ppPrimF' (Binary relOp primQueryL primQueryR) =
        hang (text "Binary:" <+> text (show relOp))
          nesting
          (parens (ppPrimF' primQueryL) $+$
            parens (ppPrimF' primQueryR))
      ppPrimF' (Special specialOp primQuery) =
        hang (text "Special:" <+> text (show specialOp))
          nesting
          (parens (ppPrimF' primQuery))
      ppPrimF' Empty = text "Empty"
  
      -- | Pretty print an Assoc list (i.e. columns and expression).
      ppAssoc :: Assoc -> Doc
      ppAssoc assoc = fsep . punctuate comma . map (\(a, e) -> text a <> colon <+> ppExpr e) $ assoc
      
      -- | Pretty print an PrimExpr value.
      ppExpr :: PrimExpr -> Doc
      ppExpr = text . show
  
  ppPQ :: (PrimQuery -> SqlSelect) -- ^ Function to turn primitive query into a SqlSelect.
    -> (PrimQuery -> PrimQuery) -- ^ Transformation to apply to query, if any.
    -> PrimQuery -- ^ The primitive query to transform and print.
    -> Doc
  ppPQ select trans prim = ppSqlSelect . select . trans $ prim
  
  ppSqlSelect :: SqlSelect -> Doc
  ppSqlSelect (SqlBin string sqlSelectL sqlSelectR) =
    hang (text "SqlBin:" <+> text string) nesting
      (parens (ppSqlSelect sqlSelectL) $+$
        parens (ppSqlSelect sqlSelectR))
  ppSqlSelect (SqlTable sqlTable) = text "SqlTable:" <+> text sqlTable
  ppSqlSelect SqlEmpty = text "SqlEmpty"
  ppSqlSelect (SqlSelect options attrs tables criteria groupby orderby extra) =
    hang (text "SqlSelect") nesting $
      hang (text "attrs:") nesting (brackets . fsep . punctuate comma . map ppAttr $ attrs) $+$
        text "criteria:" <+> (brackets . fsep . punctuate comma . map ppSqlExpr $ criteria) $+$
        hang (text "tables:") nesting (brackets . fsep . punctuate comma . map ppTable $ tables) $+$
        maybe (text "groupby: empty") ppGroupBy groupby $+$
        hang (text "orderby:") nesting (brackets . fsep . punctuate comma . map ppOrder $ orderby) $+$
        text "extras:" <+> (brackets . fsep. punctuate comma . map text $ extra) $+$
        text "options:" <+> (brackets . fsep . punctuate comma . map text $ options)
  
  ppGroupBy All = text "groupby: all"
  ppGroupBy (Columns cs) = hang (text "groupby:") nesting (brackets . fsep . punctuate comma . map ppAttr $ cs)
  
  ppTable :: (SqlTable, SqlSelect) -> Doc
  ppTable (tbl, select) =
    if null tbl
      then ppSqlSelect select
      else hang (text tbl <> colon) nesting (ppSqlSelect select)
  
  ppAttr :: (SqlColumn, SqlExpr) -> Doc
  ppAttr (col, expr) = text col <> colon <+> ppSqlExpr expr
  
  ppOrder :: (SqlExpr, SqlOrder) -> Doc
  ppOrder (expr, order) = parens (ppSqlExpr expr) <+> text (show order)
  
  ppSqlExpr :: SqlExpr -> Doc
  ppSqlExpr sql = text $ show sql
  
  -- | Nesting level.
  nesting :: Int
  nesting = 2