{-# LANGUAGE PatternGuards #-}
module Database.PostgreSQL.Typed.SQLToken
( SQLToken(..)
, sqlTokens
) where
import Control.Arrow (first)
import Data.Char (isDigit, isAsciiUpper, isAsciiLower)
import Data.List (stripPrefix)
import Data.String (IsString(..))
data SQLToken
= SQLToken String
| SQLParam Int
| SQLExpr String
| SQLQMark Bool
deriving (SQLToken -> SQLToken -> Bool
(SQLToken -> SQLToken -> Bool)
-> (SQLToken -> SQLToken -> Bool) -> Eq SQLToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SQLToken -> SQLToken -> Bool
$c/= :: SQLToken -> SQLToken -> Bool
== :: SQLToken -> SQLToken -> Bool
$c== :: SQLToken -> SQLToken -> Bool
Eq)
instance Show SQLToken where
showsPrec :: Int -> SQLToken -> ShowS
showsPrec Int
_ (SQLToken String
s) = String -> ShowS
showString String
s
showsPrec Int
_ (SQLParam Int
p) = Char -> ShowS
showChar Char
'$' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
p
showsPrec Int
_ (SQLExpr String
e) = String -> ShowS
showString String
"${" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
showsPrec Int
_ (SQLQMark Bool
False) = Char -> ShowS
showChar Char
'?'
showsPrec Int
_ (SQLQMark Bool
True) = String -> ShowS
showString String
"\\?"
showList :: [SQLToken] -> ShowS
showList = (String -> [SQLToken] -> String) -> [SQLToken] -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String -> [SQLToken] -> String) -> [SQLToken] -> ShowS)
-> (String -> [SQLToken] -> String) -> [SQLToken] -> ShowS
forall a b. (a -> b) -> a -> b
$ (SQLToken -> ShowS) -> String -> [SQLToken] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SQLToken -> ShowS
forall a. Show a => a -> ShowS
shows
instance IsString SQLToken where
fromString :: String -> SQLToken
fromString = String -> SQLToken
SQLToken
type PH = String -> [SQLToken]
infixr 4 ++:, +:
(++:) :: String -> [SQLToken] -> [SQLToken]
String
p ++: :: String -> [SQLToken] -> [SQLToken]
++: (SQLToken String
q : [SQLToken]
l) = String -> SQLToken
SQLToken (String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
q) SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: [SQLToken]
l
String
p ++: [SQLToken]
l = String -> SQLToken
SQLToken String
p SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: [SQLToken]
l
(+:) :: Char -> [SQLToken] -> [SQLToken]
Char
p +: :: Char -> [SQLToken] -> [SQLToken]
+: (SQLToken String
q : [SQLToken]
l) = String -> SQLToken
SQLToken (Char
p Char -> ShowS
forall a. a -> [a] -> [a]
: String
q) SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: [SQLToken]
l
Char
p +: [SQLToken]
l = String -> SQLToken
SQLToken [Char
p] SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: [SQLToken]
l
x :: PH
x :: PH
x (Char
'-':Char
'-':String
s) = String
"--" String -> [SQLToken] -> [SQLToken]
++: PH
comment String
s
x (Char
'e':Char
'\'':String
s) = String
"e'" String -> [SQLToken] -> [SQLToken]
++: PH
xe String
s
x (Char
'E':Char
'\'':String
s) = String
"E'" String -> [SQLToken] -> [SQLToken]
++: PH
xe String
s
x (Char
'\'':String
s) = Char
'\'' Char -> [SQLToken] -> [SQLToken]
+: PH
xq String
s
x (Char
'$':Char
'{':String
s) = PH
expr String
s
x (Char
'$':Char
'$':String
s) = String
"$$" String -> [SQLToken] -> [SQLToken]
++: String -> PH
xdolq String
"" String
s
x (Char
'$':Char
c:String
s)
| Char -> Bool
dolqStart Char
c
, (String
t,Char
'$':String
r) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
dolqCont String
s
= Char
'$' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
t String -> [SQLToken] -> [SQLToken]
++: Char
'$' Char -> [SQLToken] -> [SQLToken]
+: String -> PH
xdolq (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
t) String
r
| Char -> Bool
isDigit Char
c
, (String
i,String
r) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s
= Int -> SQLToken
SQLParam (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
i) SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: PH
x String
r
x (Char
'"':String
s) = Char
'"' Char -> [SQLToken] -> [SQLToken]
+: PH
xd String
s
x (Char
'/':Char
'*':String
s) = String
"/*" String -> [SQLToken] -> [SQLToken]
++: Int -> PH
xc Int
1 String
s
x (Char
c:String
s)
| Char -> Bool
identStart Char
c
, (String
i,String
r) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
identCont String
s
= Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
i String -> [SQLToken] -> [SQLToken]
++: PH
x String
r
x (Char
'\\':Char
'?':String
s) = Bool -> SQLToken
SQLQMark Bool
True SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: PH
x String
s
x (Char
'?':String
s) = Bool -> SQLToken
SQLQMark Bool
False SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: PH
x String
s
x (Char
c:String
s) = Char
c Char -> [SQLToken] -> [SQLToken]
+: PH
x String
s
x [] = []
xthru :: (Char -> Bool) -> PH
xthru :: (Char -> Bool) -> PH
xthru Char -> Bool
f String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
f String
s of
(String
p, Char
c:String
r) -> String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> [SQLToken] -> [SQLToken]
++: PH
x String
r
(String
p, []) -> [String -> SQLToken
SQLToken String
p]
comment :: PH
= (Char -> Bool) -> PH
xthru (\Char
n -> Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
n Bool -> Bool -> Bool
|| Char
'\r' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
n)
xe :: PH
xe :: PH
xe (Char
'\\':Char
c:String
s) = Char
'\\' Char -> [SQLToken] -> [SQLToken]
+: Char
c Char -> [SQLToken] -> [SQLToken]
+: PH
xe String
s
xe (Char
'\'':String
s) = Char
'\'' Char -> [SQLToken] -> [SQLToken]
+: PH
x String
s
xe (Char
c:String
s) = Char
c Char -> [SQLToken] -> [SQLToken]
+: PH
xe String
s
xe [] = []
xq :: PH
xq :: PH
xq = (Char -> Bool) -> PH
xthru (Char
'\'' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)
xd :: PH
xd :: PH
xd = (Char -> Bool) -> PH
xthru (Char
'\"' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)
identStart, identCont, dolqStart, dolqCont :: Char -> Bool
identStart :: Char -> Bool
identStart Char
c = Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\128' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\255' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
dolqStart :: Char -> Bool
dolqStart = Char -> Bool
identStart
dolqCont :: Char -> Bool
dolqCont Char
c = Char -> Bool
dolqStart Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c
identCont :: Char -> Bool
identCont Char
c = Char -> Bool
dolqCont Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$'
xdolq :: String -> PH
xdolq :: String -> PH
xdolq String
t = PH
dolq where
dolq :: PH
dolq (Char
'$':String
s)
| Just String
r <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
t' String
s = Char
'$'Char -> ShowS
forall a. a -> [a] -> [a]
:String
t' String -> [SQLToken] -> [SQLToken]
++: PH
x String
r
dolq (Char
c:String
s) = Char
c Char -> [SQLToken] -> [SQLToken]
+: PH
dolq String
s
dolq [] = []
t' :: String
t' = String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"$"
xc :: Int -> PH
xc :: Int -> PH
xc Int
0 String
s = PH
x String
s
xc Int
n (Char
'/':Char
'*':String
s) = String
"/*" String -> [SQLToken] -> [SQLToken]
++: Int -> PH
xc (Int -> Int
forall a. Enum a => a -> a
succ Int
n) String
s
xc Int
n (Char
'*':Char
'/':String
s) = String
"*/" String -> [SQLToken] -> [SQLToken]
++: Int -> PH
xc (Int -> Int
forall a. Enum a => a -> a
pred Int
n) String
s
xc Int
n (Char
c:String
s) = Char
c Char -> [SQLToken] -> [SQLToken]
+: Int -> PH
xc Int
n String
s
xc Int
_ [] = []
expr :: PH
expr :: PH
expr = (String, Maybe [SQLToken]) -> [SQLToken]
pr ((String, Maybe [SQLToken]) -> [SQLToken])
-> (String -> (String, Maybe [SQLToken])) -> PH
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> (String, Maybe [SQLToken])
forall a.
(Eq a, Num a, Enum a) =>
a -> String -> (String, Maybe [SQLToken])
ex (Int
0 :: Int) where
pr :: (String, Maybe [SQLToken]) -> [SQLToken]
pr (String
e, Maybe [SQLToken]
Nothing) = [String -> SQLToken
SQLToken (String
"${" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)]
pr (String
e, Just [SQLToken]
r) = String -> SQLToken
SQLExpr String
e SQLToken -> [SQLToken] -> [SQLToken]
forall a. a -> [a] -> [a]
: [SQLToken]
r
ex :: a -> String -> (String, Maybe [SQLToken])
ex a
0 (Char
'}':String
s) = (String
"", [SQLToken] -> Maybe [SQLToken]
forall a. a -> Maybe a
Just ([SQLToken] -> Maybe [SQLToken]) -> [SQLToken] -> Maybe [SQLToken]
forall a b. (a -> b) -> a -> b
$ PH
x String
s)
ex a
n (Char
'}':String
s) = ShowS -> (String, Maybe [SQLToken]) -> (String, Maybe [SQLToken])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
'}'Char -> ShowS
forall a. a -> [a] -> [a]
:) ((String, Maybe [SQLToken]) -> (String, Maybe [SQLToken]))
-> (String, Maybe [SQLToken]) -> (String, Maybe [SQLToken])
forall a b. (a -> b) -> a -> b
$ a -> String -> (String, Maybe [SQLToken])
ex (a -> a
forall a. Enum a => a -> a
pred a
n) String
s
ex a
n (Char
'{':String
s) = ShowS -> (String, Maybe [SQLToken]) -> (String, Maybe [SQLToken])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
'{'Char -> ShowS
forall a. a -> [a] -> [a]
:) ((String, Maybe [SQLToken]) -> (String, Maybe [SQLToken]))
-> (String, Maybe [SQLToken]) -> (String, Maybe [SQLToken])
forall a b. (a -> b) -> a -> b
$ a -> String -> (String, Maybe [SQLToken])
ex (a -> a
forall a. Enum a => a -> a
succ a
n) String
s
ex a
n (Char
c:String
s) = ShowS -> (String, Maybe [SQLToken]) -> (String, Maybe [SQLToken])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:) ((String, Maybe [SQLToken]) -> (String, Maybe [SQLToken]))
-> (String, Maybe [SQLToken]) -> (String, Maybe [SQLToken])
forall a b. (a -> b) -> a -> b
$ a -> String -> (String, Maybe [SQLToken])
ex a
n String
s
ex a
_ [] = (String
"", Maybe [SQLToken]
forall a. Maybe a
Nothing)
sqlTokens :: String -> [SQLToken]
sqlTokens :: PH
sqlTokens = PH
x