module Database.PostgreSQL.Parser
( Parser, runParser, evalParser
, eof
, netAddress
, v4HostAddress, decMask4
, v6HostAddress, decMask6
) where
import Control.Applicative ((<$>), pure, (<*>), (<*), (*>), (<|>), many, some, optional)
import Control.Monad (guard, replicateM)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Char (isDigit, isHexDigit)
import Data.Word (Word8, Word16)
import Numeric (readDec, readHex)
import Text.Parser.List (runParser, evalParser, eof, noteP, satisfy', satisfy)
import qualified Text.Parser.List as P
import Data.PostgreSQL.NetworkAddress (NetAddress (..), V4HostAddress, V6HostAddress)
import qualified Data.PostgreSQL.NetworkAddress as D
type Parser = P.Parser Char
digit :: Parser Char
digit :: Parser Char
digit = [Char] -> (Char -> [Char]) -> (Char -> Bool) -> Parser Char
forall t. [Char] -> (t -> [Char]) -> (t -> Bool) -> Parser t t
satisfy' [Char]
"digit" ([Char] -> Char -> [Char]
forall a b. a -> b -> a
const [Char]
"must be digit.") Char -> Bool
isDigit
hexDigit :: Parser Char
hexDigit :: Parser Char
hexDigit = [Char] -> (Char -> [Char]) -> (Char -> Bool) -> Parser Char
forall t. [Char] -> (t -> [Char]) -> (t -> Bool) -> Parser t t
satisfy' [Char]
"hexDigit" ([Char] -> Char -> [Char]
forall a b. a -> b -> a
const [Char]
"must be hex-digit.") Char -> Bool
isHexDigit
readNat :: String -> Maybe Integer
readNat :: [Char] -> Maybe Integer
readNat [Char]
s = [Integer] -> Maybe Integer
forall a. [a] -> Maybe a
listToMaybe [ Integer
i | (Integer
i, [Char]
"") <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readDec [Char]
s ]
readHexNat :: String -> Maybe Integer
readHexNat :: [Char] -> Maybe Integer
readHexNat [Char]
s = [Integer] -> Maybe Integer
forall a. [a] -> Maybe a
listToMaybe [ Integer
i | (Integer
i, [Char]
"") <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex [Char]
s ]
nat :: Parser Integer
nat :: Parser Integer
nat = do
[Char]
xs <- Parser Char -> StateT [Char] (Except Error) [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
digit
[Char] -> Maybe Integer -> Parser Integer
forall a t. [Char] -> Maybe a -> Parser t a
noteP [Char]
"nat: invalid input" (Maybe Integer -> Parser Integer)
-> Maybe Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Integer
readNat [Char]
xs
hexNat :: Parser Integer
hexNat :: Parser Integer
hexNat = do
[Char]
xs <- Parser Char -> StateT [Char] (Except Error) [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
hexDigit
[Char] -> Maybe Integer -> Parser Integer
forall a t. [Char] -> Maybe a -> Parser t a
noteP [Char]
"hexNat: invalid input" (Maybe Integer -> Parser Integer)
-> Maybe Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Integer
readHexNat [Char]
xs
rangedNat :: (Integral a, Show a) => a -> a -> Integer -> Parser a
rangedNat :: forall a. (Integral a, Show a) => a -> a -> Integer -> Parser a
rangedNat a
n a
x Integer
i = do
[Char] -> Maybe () -> Parser Char ()
forall a t. [Char] -> Maybe a -> Parser t a
noteP ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"rangedNat: out of range: ", Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i, [Char]
": [", a -> [Char]
forall a. Show a => a -> [Char]
show a
n, [Char]
", ", a -> [Char]
forall a. Show a => a -> [Char]
show a
x, [Char]
"]"])
(Maybe () -> Parser Char ())
-> (Bool -> Maybe ()) -> Bool -> Parser Char ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser Char ()) -> Bool -> Parser Char ()
forall a b. (a -> b) -> a -> b
$ (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
decW8 :: Parser Word8
decW8 :: Parser Word8
decW8 = Word8 -> Word8 -> Integer -> Parser Word8
forall a. (Integral a, Show a) => a -> a -> Integer -> Parser a
rangedNat Word8
forall a. Bounded a => a
minBound Word8
forall a. Bounded a => a
maxBound (Integer -> Parser Word8) -> Parser Integer -> Parser Word8
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Integer
nat
hexW16 :: Parser Word16
hexW16 :: Parser Word16
hexW16 = Word16 -> Word16 -> Integer -> Parser Word16
forall a. (Integral a, Show a) => a -> a -> Integer -> Parser a
rangedNat Word16
forall a. Bounded a => a
minBound Word16
forall a. Bounded a => a
maxBound (Integer -> Parser Word16) -> Parser Integer -> Parser Word16
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Integer
hexNat
char :: Char -> Parser Char
char :: Char -> Parser Char
char Char
c = (Char -> Bool) -> Parser Char
forall t. (t -> Bool) -> Parser t t
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
dot :: Parser Char
dot :: Parser Char
dot = Char -> Parser Char
char Char
'.'
colon :: Parser Char
colon :: Parser Char
colon = Char -> Parser Char
char Char
':'
slash :: Parser Char
slash :: Parser Char
slash = Char -> Parser Char
char Char
'/'
v4HostAddress :: Parser V4HostAddress
v4HostAddress :: Parser V4HostAddress
v4HostAddress = Word8 -> Word8 -> Word8 -> Word8 -> V4HostAddress
D.V4HostAddress (Word8 -> Word8 -> Word8 -> Word8 -> V4HostAddress)
-> Parser Word8
-> StateT
[Char] (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
decW8 StateT
[Char] (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
-> Parser Char
-> StateT
[Char] (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
dot StateT
[Char] (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
-> Parser Word8
-> StateT [Char] (Except Error) (Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
decW8 StateT [Char] (Except Error) (Word8 -> Word8 -> V4HostAddress)
-> Parser Char
-> StateT [Char] (Except Error) (Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
dot StateT [Char] (Except Error) (Word8 -> Word8 -> V4HostAddress)
-> Parser Word8
-> StateT [Char] (Except Error) (Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
decW8 StateT [Char] (Except Error) (Word8 -> V4HostAddress)
-> Parser Char
-> StateT [Char] (Except Error) (Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
dot StateT [Char] (Except Error) (Word8 -> V4HostAddress)
-> Parser Word8 -> Parser V4HostAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
decW8
_exampleHostAddress :: [Either String V4HostAddress]
_exampleHostAddress :: [Either [Char] V4HostAddress]
_exampleHostAddress =
[ Parser V4HostAddress -> [Char] -> Either [Char] V4HostAddress
forall t a. Parser t a -> [t] -> Either [Char] a
evalParser (Parser V4HostAddress
v4HostAddress Parser V4HostAddress -> Parser Char () -> Parser V4HostAddress
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char ()
forall t. Parser t ()
eof) [Char]
s
| [Char]
s <- [ [Char]
"0.0.0.0", [Char]
"192.168.0.1" ]
]
mask4bits :: Word8
mask4bits :: Word8
mask4bits = Word8
32
decMask4 :: Parser Word8
decMask4 :: Parser Word8
decMask4 = Word8 -> Word8 -> Integer -> Parser Word8
forall a. (Integral a, Show a) => a -> a -> Integer -> Parser a
rangedNat Word8
0 Word8
mask4bits (Integer -> Parser Word8) -> Parser Integer -> Parser Word8
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Integer
nat
v6words :: Parser [Word16]
v6words :: Parser [Word16]
v6words =
(:) (Word16 -> [Word16] -> [Word16])
-> Parser Word16
-> StateT [Char] (Except Error) ([Word16] -> [Word16])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
hexW16 StateT [Char] (Except Error) ([Word16] -> [Word16])
-> Parser [Word16] -> Parser [Word16]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16 -> Parser [Word16]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Char
colon Parser Char -> Parser Word16 -> Parser Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word16
hexW16) Parser [Word16] -> Parser [Word16] -> Parser [Word16]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
[Word16] -> Parser [Word16]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
doubleColon6 :: Parser V6HostAddress
doubleColon6 :: Parser V6HostAddress
doubleColon6 = do
Maybe V6HostAddress
m6 <- [Word16] -> [Word16] -> Maybe V6HostAddress
D.v6HostAddress ([Word16] -> [Word16] -> Maybe V6HostAddress)
-> Parser [Word16]
-> StateT [Char] (Except Error) ([Word16] -> Maybe V6HostAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Word16]
v6words StateT [Char] (Except Error) ([Word16] -> Maybe V6HostAddress)
-> StateT [Char] (Except Error) [Char]
-> StateT [Char] (Except Error) ([Word16] -> Maybe V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Parser Char -> StateT [Char] (Except Error) [Char]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Parser Char
colon StateT [Char] (Except Error) ([Word16] -> Maybe V6HostAddress)
-> Parser [Word16]
-> StateT [Char] (Except Error) (Maybe V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Word16]
v6words
[Char] -> Maybe V6HostAddress -> Parser V6HostAddress
forall a t. [Char] -> Maybe a -> Parser t a
noteP [Char]
"v6HostAddress: Too many numbers of 16-bit words." Maybe V6HostAddress
m6
v6HostAddress :: Parser V6HostAddress
v6HostAddress :: Parser V6HostAddress
v6HostAddress =
Parser V6HostAddress
doubleColon6 Parser V6HostAddress
-> Parser V6HostAddress -> Parser V6HostAddress
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress
D.v6HostAddressLong
(Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress)
-> Parser Word16
-> StateT
[Char]
(Except Error)
(Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
hexW16 StateT
[Char]
(Except Error)
(Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress)
-> Parser Char
-> StateT
[Char]
(Except Error)
(Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon StateT
[Char]
(Except Error)
(Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress)
-> Parser Word16
-> StateT
[Char]
(Except Error)
(Word16
-> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT
[Char]
(Except Error)
(Word16
-> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
[Char]
(Except Error)
(Word16
-> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon
StateT
[Char]
(Except Error)
(Word16
-> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon
StateT
[Char]
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT
[Char] (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT
[Char] (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
[Char] (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon StateT
[Char] (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT [Char] (Except Error) (Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT [Char] (Except Error) (Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT [Char] (Except Error) (Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon
StateT [Char] (Except Error) (Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT [Char] (Except Error) (Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT [Char] (Except Error) (Word16 -> V6HostAddress)
-> Parser Char
-> StateT [Char] (Except Error) (Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon StateT [Char] (Except Error) (Word16 -> V6HostAddress)
-> Parser Word16 -> Parser V6HostAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16
_exampleHostAddress6 :: [Either String V6HostAddress]
_exampleHostAddress6 :: [Either [Char] V6HostAddress]
_exampleHostAddress6 =
[ Parser V6HostAddress -> [Char] -> Either [Char] V6HostAddress
forall t a. Parser t a -> [t] -> Either [Char] a
evalParser (Parser V6HostAddress
v6HostAddress Parser V6HostAddress -> Parser Char () -> Parser V6HostAddress
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char ()
forall t. Parser t ()
eof) [Char]
s
| [Char]
s <- [ [Char]
"::", [Char]
"0:0:0:0:0:0:0:0", [Char]
"2001:1::1:a2", [Char]
"1:1:1:1:1:1:1:a1" ]
]
mask6bits :: Word8
mask6bits :: Word8
mask6bits = Word8
128
decMask6 :: Parser Word8
decMask6 :: Parser Word8
decMask6 = Word8 -> Word8 -> Integer -> Parser Word8
forall a. (Integral a, Show a) => a -> a -> Integer -> Parser a
rangedNat Word8
0 Word8
mask6bits (Integer -> Parser Word8) -> Parser Integer -> Parser Word8
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Integer
nat
optional' :: a -> Parser a -> Parser a
optional' :: forall a. a -> Parser a -> Parser a
optional' a
x Parser a
p =
a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a)
-> StateT [Char] (Except Error) (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> StateT [Char] (Except Error) (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser a
p
netAddress :: Parser NetAddress
netAddress :: Parser NetAddress
netAddress =
V4HostAddress -> Word8 -> NetAddress
NetAddress4 (V4HostAddress -> Word8 -> NetAddress)
-> Parser V4HostAddress
-> StateT [Char] (Except Error) (Word8 -> NetAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser V4HostAddress
v4HostAddress StateT [Char] (Except Error) (Word8 -> NetAddress)
-> Parser Word8 -> Parser NetAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Parser Word8 -> Parser Word8
forall a. a -> Parser a -> Parser a
optional' Word8
mask4bits (Parser Char
slash Parser Char -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word8
decMask4) Parser NetAddress -> Parser NetAddress -> Parser NetAddress
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
V6HostAddress -> Word8 -> NetAddress
NetAddress6 (V6HostAddress -> Word8 -> NetAddress)
-> Parser V6HostAddress
-> StateT [Char] (Except Error) (Word8 -> NetAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser V6HostAddress
v6HostAddress StateT [Char] (Except Error) (Word8 -> NetAddress)
-> Parser Word8 -> Parser NetAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Parser Word8 -> Parser Word8
forall a. a -> Parser a -> Parser a
optional' Word8
mask6bits (Parser Char
slash Parser Char -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word8
decMask6)
_exampleNetAddress :: [Either String NetAddress]
_exampleNetAddress :: [Either [Char] NetAddress]
_exampleNetAddress =
[ Parser NetAddress -> [Char] -> Either [Char] NetAddress
forall t a. Parser t a -> [t] -> Either [Char] a
evalParser (Parser NetAddress
netAddress Parser NetAddress -> Parser Char () -> Parser NetAddress
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char ()
forall t. Parser t ()
eof) [Char]
s
| [Char]
s <- [ [Char]
"2001:1::a0:a2/64", [Char]
"172.16.0.0" ]
]