{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.Keyword.Concat (
unwords',
sepBy, parenSepBy,
defineBinOp,
strBinOp,
as, (<.>), (|*|),
(.||.),
(.=.), (.<.), (.<=.), (.>.), (.>=.), (.<>.),
and, or, in',
(<++>),
fold,
defineUniOp, paren,
strUniOp
) where
import Prelude hiding (and, or, not)
import Data.List (intersperse)
import Data.Monoid (mempty, mconcat, (<>))
import Language.SQL.Keyword.Internal.Type (Keyword (..), word, wordShow, toDString, fromDString)
sepBy' :: [Keyword] -> Keyword -> [String]
ws `sepBy'` d = map wordShow . intersperse d $ ws
unwords' :: [Keyword] -> Keyword
unwords' = mconcat
concatStr :: [String] -> Keyword
concatStr = word . concat
sepBy :: [Keyword] -> Keyword -> Keyword
ws `sepBy` d = concatStr $ ws `sepBy'` d
parenSepBy :: [Keyword] -> Keyword -> Keyword
ws `parenSepBy` d = concatStr $ "(" : (ws `sepBy'` d) ++ [")"]
(<++>) :: Keyword -> Keyword -> Keyword
x <++> y = fromDString $ toDString x <> toDString y
concat' :: [Keyword] -> Keyword
concat' = fromDString . mconcat . map toDString
defineBinOp' :: Keyword -> Keyword -> Keyword -> Keyword
defineBinOp' op a b = concat' [a, op, b]
defineBinOp :: Keyword -> Keyword -> Keyword -> Keyword
defineBinOp op a b = mconcat [a, op, b]
(<.>) :: Keyword -> Keyword -> Keyword
(<.>) = defineBinOp' "."
(|*|) :: Keyword -> Keyword -> Keyword
(|*|) = defineBinOp' ", "
(.||.) :: Keyword -> Keyword -> Keyword
(.||.) = defineBinOp "||"
(.=.) :: Keyword -> Keyword -> Keyword
(.=.) = defineBinOp "="
(.<>.) :: Keyword -> Keyword -> Keyword
(.<>.) = defineBinOp "<>"
(.<.) :: Keyword -> Keyword -> Keyword
(.<.) = defineBinOp "<"
(.<=.) :: Keyword -> Keyword -> Keyword
(.<=.) = defineBinOp "<="
(.>.) :: Keyword -> Keyword -> Keyword
(.>.) = defineBinOp ">"
(.>=.) :: Keyword -> Keyword -> Keyword
(.>=.) = defineBinOp ">="
as :: Keyword -> Keyword -> Keyword
as = defineBinOp AS
and :: Keyword -> Keyword -> Keyword
and = defineBinOp AND
or :: Keyword -> Keyword -> Keyword
or = defineBinOp OR
fold :: (Keyword -> Keyword -> Keyword)
-> [Keyword]
-> Keyword
fold op = d where
d [] = mempty
d xs@(_:_) = foldr1 op xs
defineUniOp :: Keyword -> Keyword -> Keyword
defineUniOp op e = mconcat [op, e]
paren :: Keyword -> Keyword
paren w = concat' ["(", w, ")"]
in' :: Keyword -> Keyword -> Keyword
in' = defineBinOp IN
infixr 6 <++>
infixr 5 .||.
infixr 4 .=., .<., .<=., .>., .>=., .<>.
infix 4 `in'`
infixr 3 `and`
infixr 2 `or`
infixr 1 |*|
strUniOp :: (Keyword -> Keyword) -> String -> String
strUniOp u = wordShow . u . word
strBinOp :: (Keyword -> Keyword -> Keyword) -> String -> String -> String
strBinOp op a b = wordShow $ op (word a) (word b)