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