module Opaleye.SQLite.Internal.Print where

import           Prelude hiding (product)

import qualified Opaleye.SQLite.Internal.Sql as Sql
import           Opaleye.SQLite.Internal.Sql (Select(SelectFrom, Table,
                                              SelectJoin,
                                              SelectValues,
                                              SelectBinary),
                                       From, Join, Values, Binary)

import qualified Opaleye.SQLite.Internal.HaskellDB.Sql as HSql
import qualified Opaleye.SQLite.Internal.HaskellDB.Sql.Print as HPrint

import           Text.PrettyPrint.HughesPJ (Doc, ($$), (<+>), text, empty,
                                            parens)
import qualified Data.List.NonEmpty as NEL

type TableAlias = String

ppSql :: Select -> Doc
ppSql :: Select -> Doc
ppSql (SelectFrom From
s) = From -> Doc
ppSelectFrom From
s
ppSql (Table SqlTable
table) = SqlTable -> Doc
HPrint.ppTable SqlTable
table
ppSql (SelectJoin Join
j) = Join -> Doc
ppSelectJoin Join
j
ppSql (SelectValues Values
v) = Values -> Doc
ppSelectValues Values
v
ppSql (SelectBinary Binary
v) = Binary -> Doc
ppSelectBinary Binary
v

ppSelectFrom :: From -> Doc
ppSelectFrom :: From -> Doc
ppSelectFrom From
s = String -> Doc
text String
"SELECT"
                 Doc -> Doc -> Doc
<+> SelectAttrs -> Doc
ppAttrs (From -> SelectAttrs
Sql.attrs From
s)
                 Doc -> Doc -> Doc
$$  [Select] -> Doc
ppTables (From -> [Select]
Sql.tables From
s)
                 Doc -> Doc -> Doc
$$  [SqlExpr] -> Doc
HPrint.ppWhere (From -> [SqlExpr]
Sql.criteria From
s)
                 Doc -> Doc -> Doc
$$  Maybe (NonEmpty SqlExpr) -> Doc
ppGroupBy (From -> Maybe (NonEmpty SqlExpr)
Sql.groupBy From
s)
                 Doc -> Doc -> Doc
$$  [(SqlExpr, SqlOrder)] -> Doc
HPrint.ppOrderBy (From -> [(SqlExpr, SqlOrder)]
Sql.orderBy From
s)
                 Doc -> Doc -> Doc
$$  Maybe Int -> Doc
ppLimit (From -> Maybe Int
Sql.limit From
s)
                 Doc -> Doc -> Doc
$$  Maybe Int -> Doc
ppOffset (From -> Maybe Int
Sql.offset From
s)


ppSelectJoin :: Join -> Doc
ppSelectJoin :: Join -> Doc
ppSelectJoin Join
j = String -> Doc
text String
"SELECT *"
                 Doc -> Doc -> Doc
$$  String -> Doc
text String
"FROM"
                 Doc -> Doc -> Doc
$$  (String, Select) -> Doc
ppTable (Int -> Select -> (String, Select)
tableAlias Int
1 Select
s1)
                 Doc -> Doc -> Doc
$$  JoinType -> Doc
ppJoinType (Join -> JoinType
Sql.jJoinType Join
j)
                 Doc -> Doc -> Doc
$$  (String, Select) -> Doc
ppTable (Int -> Select -> (String, Select)
tableAlias Int
2 Select
s2)
                 Doc -> Doc -> Doc
$$  String -> Doc
text String
"ON"
                 Doc -> Doc -> Doc
$$  SqlExpr -> Doc
HPrint.ppSqlExpr (Join -> SqlExpr
Sql.jCond Join
j)
  where (Select
s1, Select
s2) = Join -> (Select, Select)
Sql.jTables Join
j

ppSelectValues :: Values -> Doc
ppSelectValues :: Values -> Doc
ppSelectValues Values
v = String -> Doc
text String
"SELECT"
                   Doc -> Doc -> Doc
<+> SelectAttrs -> Doc
ppAttrs (Values -> SelectAttrs
Sql.vAttrs Values
v)
                   Doc -> Doc -> Doc
$$  String -> Doc
text String
"FROM"
                   Doc -> Doc -> Doc
$$  [[SqlExpr]] -> Doc
ppValues (Values -> [[SqlExpr]]
Sql.vValues Values
v)

ppSelectBinary :: Binary -> Doc
ppSelectBinary :: Binary -> Doc
ppSelectBinary Binary
b = Select -> Doc
ppSql (Binary -> Select
Sql.bSelect1 Binary
b)
                   Doc -> Doc -> Doc
$$ BinOp -> Doc
ppBinOp (Binary -> BinOp
Sql.bOp Binary
b)
                   Doc -> Doc -> Doc
$$ Select -> Doc
ppSql (Binary -> Select
Sql.bSelect2 Binary
b)

ppJoinType :: Sql.JoinType -> Doc
ppJoinType :: JoinType -> Doc
ppJoinType JoinType
Sql.LeftJoin = String -> Doc
text String
"LEFT OUTER JOIN"

ppAttrs :: Sql.SelectAttrs -> Doc
ppAttrs :: SelectAttrs -> Doc
ppAttrs SelectAttrs
Sql.Star             = String -> Doc
text String
"*"
ppAttrs (Sql.SelectAttrs NonEmpty (SqlExpr, Maybe SqlColumn)
xs) = (((SqlExpr, Maybe SqlColumn) -> Doc)
-> [(SqlExpr, Maybe SqlColumn)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
HPrint.commaV (SqlExpr, Maybe SqlColumn) -> Doc
nameAs ([(SqlExpr, Maybe SqlColumn)] -> Doc)
-> (NonEmpty (SqlExpr, Maybe SqlColumn)
    -> [(SqlExpr, Maybe SqlColumn)])
-> NonEmpty (SqlExpr, Maybe SqlColumn)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (SqlExpr, Maybe SqlColumn) -> [(SqlExpr, Maybe SqlColumn)]
forall a. NonEmpty a -> [a]
NEL.toList) NonEmpty (SqlExpr, Maybe SqlColumn)
xs

-- This is pretty much just nameAs from HaskellDB
nameAs :: (HSql.SqlExpr, Maybe HSql.SqlColumn) -> Doc
nameAs :: (SqlExpr, Maybe SqlColumn) -> Doc
nameAs (SqlExpr
expr, Maybe SqlColumn
name) = String -> Doc -> Doc
HPrint.ppAs (String -> (SqlColumn -> String) -> Maybe SqlColumn -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" SqlColumn -> String
unColumn Maybe SqlColumn
name) (SqlExpr -> Doc
HPrint.ppSqlExpr SqlExpr
expr)
  where unColumn :: SqlColumn -> String
unColumn (HSql.SqlColumn String
s) = String
s

ppTables :: [Select] -> Doc
ppTables :: [Select] -> Doc
ppTables [] = Doc
empty
ppTables [Select]
ts = String -> Doc
text String
"FROM" Doc -> Doc -> Doc
<+> ((String, Select) -> Doc) -> [(String, Select)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
HPrint.commaV (String, Select) -> Doc
ppTable ((Int -> Select -> (String, Select))
-> [Int] -> [Select] -> [(String, Select)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Select -> (String, Select)
tableAlias [Int
1..] [Select]
ts)

tableAlias :: Int -> Select -> (TableAlias, Select)
tableAlias :: Int -> Select -> (String, Select)
tableAlias Int
i Select
select = (String
"T" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i, Select
select)

-- TODO: duplication with ppSql
ppTable :: (TableAlias, Select) -> Doc
ppTable :: (String, Select) -> Doc
ppTable (String
alias, Select
select) = case Select
select of
  Table SqlTable
table -> String -> Doc -> Doc
HPrint.ppAs String
alias (SqlTable -> Doc
HPrint.ppTable SqlTable
table)
  SelectFrom From
selectFrom -> String -> Doc -> Doc
HPrint.ppAs String
alias (Doc -> Doc
parens (From -> Doc
ppSelectFrom From
selectFrom))
  SelectJoin Join
slj -> String -> Doc -> Doc
HPrint.ppAs String
alias (Doc -> Doc
parens (Join -> Doc
ppSelectJoin Join
slj))
  SelectValues Values
slv -> String -> Doc -> Doc
HPrint.ppAs String
alias (Doc -> Doc
parens (Values -> Doc
ppSelectValues Values
slv))
  SelectBinary Binary
slb -> String -> Doc -> Doc
HPrint.ppAs String
alias (Doc -> Doc
parens (Binary -> Doc
ppSelectBinary Binary
slb))

ppGroupBy :: Maybe (NEL.NonEmpty HSql.SqlExpr) -> Doc
ppGroupBy :: Maybe (NonEmpty SqlExpr) -> Doc
ppGroupBy Maybe (NonEmpty SqlExpr)
Nothing   = Doc
empty
ppGroupBy (Just NonEmpty SqlExpr
xs) = [SqlExpr] -> Doc
HPrint.ppGroupBy (NonEmpty SqlExpr -> [SqlExpr]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty SqlExpr
xs)

ppLimit :: Maybe Int -> Doc
ppLimit :: Maybe Int -> Doc
ppLimit Maybe Int
Nothing = Doc
empty
ppLimit (Just Int
n) = String -> Doc
text (String
"LIMIT " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)

ppOffset :: Maybe Int -> Doc
ppOffset :: Maybe Int -> Doc
ppOffset Maybe Int
Nothing = Doc
empty
ppOffset (Just Int
n) = String -> Doc
text (String
"OFFSET " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)

ppValues :: [[HSql.SqlExpr]] -> Doc
ppValues :: [[SqlExpr]] -> Doc
ppValues [[SqlExpr]]
v = String -> Doc -> Doc
HPrint.ppAs String
"V" (Doc -> Doc
parens (String -> Doc
text String
"VALUES" Doc -> Doc -> Doc
$$ ([SqlExpr] -> Doc) -> [[SqlExpr]] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
HPrint.commaV [SqlExpr] -> Doc
ppValuesRow [[SqlExpr]]
v))

ppValuesRow :: [HSql.SqlExpr] -> Doc
ppValuesRow :: [SqlExpr] -> Doc
ppValuesRow = Doc -> Doc
parens (Doc -> Doc) -> ([SqlExpr] -> Doc) -> [SqlExpr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
HPrint.commaH SqlExpr -> Doc
HPrint.ppSqlExpr

ppBinOp :: Sql.BinOp -> Doc
ppBinOp :: BinOp -> Doc
ppBinOp BinOp
o = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case BinOp
o of
  BinOp
Sql.Union    -> String
"UNION"
  BinOp
Sql.UnionAll -> String
"UNION ALL"
  BinOp
Sql.Except   -> String
"EXCEPT"

ppInsertReturning :: Sql.Returning HSql.SqlInsert -> Doc
ppInsertReturning :: Returning SqlInsert -> Doc
ppInsertReturning (Sql.Returning SqlInsert
insert [SqlExpr]
returnExprs) =
  SqlInsert -> Doc
HPrint.ppInsert SqlInsert
insert
  Doc -> Doc -> Doc
$$ String -> Doc
text String
"RETURNING"
  Doc -> Doc -> Doc
<+> (SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
HPrint.commaV SqlExpr -> Doc
HPrint.ppSqlExpr [SqlExpr]
returnExprs

ppUpdateReturning :: Sql.Returning HSql.SqlUpdate -> Doc
ppUpdateReturning :: Returning SqlUpdate -> Doc
ppUpdateReturning (Sql.Returning SqlUpdate
update [SqlExpr]
returnExprs) =
  SqlUpdate -> Doc
HPrint.ppUpdate SqlUpdate
update
  Doc -> Doc -> Doc
$$ String -> Doc
text String
"RETURNING"
  Doc -> Doc -> Doc
<+> (SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
HPrint.commaV SqlExpr -> Doc
HPrint.ppSqlExpr [SqlExpr]
returnExprs