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 = String -> (Char -> String) -> (Char -> Bool) -> Parser Char
forall t. String -> (t -> String) -> (t -> Bool) -> Parser t t
satisfy' "digit" (String -> Char -> String
forall a b. a -> b -> a
const "must be digit.") Char -> Bool
isDigit
hexDigit :: Parser Char
hexDigit :: Parser Char
hexDigit = String -> (Char -> String) -> (Char -> Bool) -> Parser Char
forall t. String -> (t -> String) -> (t -> Bool) -> Parser t t
satisfy' "hexDigit" (String -> Char -> String
forall a b. a -> b -> a
const "must be hex-digit.") Char -> Bool
isHexDigit
readNat :: String -> Maybe Integer
readNat :: String -> Maybe Integer
readNat s :: String
s = [Integer] -> Maybe Integer
forall a. [a] -> Maybe a
listToMaybe [ Integer
i | (i :: Integer
i, "") <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readDec String
s ]
readHexNat :: String -> Maybe Integer
readHexNat :: String -> Maybe Integer
readHexNat s :: String
s = [Integer] -> Maybe Integer
forall a. [a] -> Maybe a
listToMaybe [ Integer
i | (i :: Integer
i, "") <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
s ]
nat :: Parser Integer
nat :: Parser Integer
nat = do
String
xs <- Parser Char -> StateT String (Except Error) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
digit
String -> Maybe Integer -> Parser Integer
forall a t. String -> Maybe a -> Parser t a
noteP "nat: invalid input" (Maybe Integer -> Parser Integer)
-> Maybe Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$ String -> Maybe Integer
readNat String
xs
hexNat :: Parser Integer
hexNat :: Parser Integer
hexNat = do
String
xs <- Parser Char -> StateT String (Except Error) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
hexDigit
String -> Maybe Integer -> Parser Integer
forall a t. String -> Maybe a -> Parser t a
noteP "hexNat: invalid input" (Maybe Integer -> Parser Integer)
-> Maybe Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$ String -> Maybe Integer
readHexNat String
xs
rangedNat :: (Integral a, Show a) => a -> a -> Integer -> Parser a
rangedNat :: a -> a -> Integer -> Parser a
rangedNat n :: a
n x :: a
x i :: Integer
i = do
String -> Maybe () -> Parser Char ()
forall a t. String -> Maybe a -> Parser t a
noteP ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["rangedNat: out of range: ", Integer -> String
forall a. Show a => a -> String
show Integer
i, ": [", a -> String
forall a. Show a => a -> String
show a
n, ", ", a -> String
forall a. Show a => a -> String
show a
x, "]"])
(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 c :: 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 '.'
colon :: Parser Char
colon :: Parser Char
colon = Char -> Parser Char
char ':'
slash :: Parser Char
slash :: Parser Char
slash = Char -> Parser Char
char '/'
v4HostAddress :: Parser V4HostAddress
v4HostAddress :: Parser V4HostAddress
v4HostAddress = Word8 -> Word8 -> Word8 -> Word8 -> V4HostAddress
D.V4HostAddress (Word8 -> Word8 -> Word8 -> Word8 -> V4HostAddress)
-> Parser Word8
-> StateT
String (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
decW8 StateT
String (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
-> Parser Char
-> StateT
String (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
dot StateT
String (Except Error) (Word8 -> Word8 -> Word8 -> V4HostAddress)
-> Parser Word8
-> StateT String (Except Error) (Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
decW8 StateT String (Except Error) (Word8 -> Word8 -> V4HostAddress)
-> Parser Char
-> StateT String (Except Error) (Word8 -> Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
dot StateT String (Except Error) (Word8 -> Word8 -> V4HostAddress)
-> Parser Word8
-> StateT String (Except Error) (Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
decW8 StateT String (Except Error) (Word8 -> V4HostAddress)
-> Parser Char
-> StateT String (Except Error) (Word8 -> V4HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
dot StateT String (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 String V4HostAddress]
_exampleHostAddress =
[ Parser V4HostAddress -> String -> Either String V4HostAddress
forall t a. Parser t a -> [t] -> Either String 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) String
s
| String
s <- [ "0.0.0.0", "192.168.0.1" ]
]
mask4bits :: Word8
mask4bits :: Word8
mask4bits = 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 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 String (Except Error) ([Word16] -> [Word16])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
hexW16 StateT String (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 String (Except Error) ([Word16] -> Maybe V6HostAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Word16]
v6words StateT String (Except Error) ([Word16] -> Maybe V6HostAddress)
-> StateT String (Except Error) String
-> StateT String (Except Error) ([Word16] -> Maybe V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Parser Char -> StateT String (Except Error) String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM 2 Parser Char
colon StateT String (Except Error) ([Word16] -> Maybe V6HostAddress)
-> Parser [Word16]
-> StateT String (Except Error) (Maybe V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Word16]
v6words
String -> Maybe V6HostAddress -> Parser V6HostAddress
forall a t. String -> Maybe a -> Parser t a
noteP "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
String
(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
String
(Except Error)
(Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress)
-> Parser Char
-> StateT
String
(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
String
(Except Error)
(Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> V6HostAddress)
-> Parser Word16
-> StateT
String
(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
String
(Except Error)
(Word16
-> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
String
(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
String
(Except Error)
(Word16
-> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT
String
(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
String
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
String
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon StateT
String
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT
String
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT
String
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
String
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon
StateT
String
(Except Error)
(Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT
String (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT
String (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT
String (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon StateT
String (Except Error) (Word16 -> Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT String (Except Error) (Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT String (Except Error) (Word16 -> Word16 -> V6HostAddress)
-> Parser Char
-> StateT String (Except Error) (Word16 -> Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon
StateT String (Except Error) (Word16 -> Word16 -> V6HostAddress)
-> Parser Word16
-> StateT String (Except Error) (Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
hexW16 StateT String (Except Error) (Word16 -> V6HostAddress)
-> Parser Char
-> StateT String (Except Error) (Word16 -> V6HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
colon StateT String (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 String V6HostAddress]
_exampleHostAddress6 =
[ Parser V6HostAddress -> String -> Either String V6HostAddress
forall t a. Parser t a -> [t] -> Either String 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) String
s
| String
s <- [ "::", "0:0:0:0:0:0:0:0", "2001:1::1:a2", "1:1:1:1:1:1:1:a1" ]
]
mask6bits :: Word8
mask6bits :: Word8
mask6bits = 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 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' :: a -> Parser a -> Parser a
optional' x :: a
x p :: Parser a
p =
a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a)
-> StateT String (Except Error) (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> StateT String (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 String (Except Error) (Word8 -> NetAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser V4HostAddress
v4HostAddress StateT String (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 String (Except Error) (Word8 -> NetAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser V6HostAddress
v6HostAddress StateT String (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 String NetAddress]
_exampleNetAddress =
[ Parser NetAddress -> String -> Either String NetAddress
forall t a. Parser t a -> [t] -> Either String 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) String
s
| String
s <- [ "2001:1::a0:a2/64", "172.16.0.0" ]
]