text-postgresql-0.0.3.1/0000755000000000000000000000000013313350024013216 5ustar0000000000000000text-postgresql-0.0.3.1/text-postgresql.cabal0000644000000000000000000000357313313350024017377 0ustar0000000000000000name: text-postgresql version: 0.0.3.1 synopsis: Parser and Printer of PostgreSQL extended types description: This package involves parser and printer for text expressions of PostgreSQL extended types. - inet type, cidr type homepage: http://khibino.github.io/haskell-relational-record/ license: BSD3 license-file: LICENSE author: Kei Hibino maintainer: ex8k.hibino@gmail.com copyright: Copyright (c) 2015-2018 Kei Hibino category: Database build-type: Simple cabal-version: >=1.10 tested-with: GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3 , GHC == 8.2.1, GHC == 8.2.2 , GHC == 8.0.1, GHC == 8.0.2 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4 , GHC == 7.6.1, GHC == 7.6.2, GHC == 7.6.3 , GHC == 7.4.1, GHC == 7.4.2 library exposed-modules: Data.PostgreSQL.NetworkAddress Database.PostgreSQL.Parser Database.PostgreSQL.Printer other-modules: Text.Parser.List Text.Printer.List build-depends: base <5 , transformers , transformers-compat , dlist hs-source-dirs: src default-language: Haskell2010 test-suite test-prop build-depends: base <5 , QuickCheck , quickcheck-simple , text-postgresql type: exitcode-stdio-1.0 main-is: prop.hs hs-source-dirs: test ghc-options: -Wall default-language: Haskell2010 text-postgresql-0.0.3.1/Setup.hs0000644000000000000000000000005613313350024014653 0ustar0000000000000000import Distribution.Simple main = defaultMain text-postgresql-0.0.3.1/LICENSE0000644000000000000000000000275613313350024014235 0ustar0000000000000000Copyright (c) 2015, Kei Hibino All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Kei Hibino nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. text-postgresql-0.0.3.1/test/0000755000000000000000000000000013313350024014175 5ustar0000000000000000text-postgresql-0.0.3.1/test/prop.hs0000644000000000000000000001246113313350024015515 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} import Test.QuickCheck (Gen, Arbitrary (..), choose, oneof) import Test.QuickCheck.Simple (defaultMain, Test, qcTest) import Control.Applicative ((<$>), (<*>)) import Control.Monad (replicateM) import Data.Maybe (fromJust) import Data.List (isPrefixOf, isSuffixOf) import Data.Word (Word8, Word16) import Data.PostgreSQL.NetworkAddress import Database.PostgreSQL.Parser (Parser, evalParser) import qualified Database.PostgreSQL.Parser as Parser import Database.PostgreSQL.Printer (Printer, execPrinter) import qualified Database.PostgreSQL.Printer as Printer instance Arbitrary V4HostAddress where arbitrary = V4HostAddress <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary V6HostAddress where arbitrary = V6HostAddress <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary mask4 :: Gen Word8 mask4 = choose (0, 32) mask6 :: Gen Word8 mask6 = choose (0, 128) newtype A6Input = A6Input [Word16] deriving (Eq, Show) instance Arbitrary A6Input where arbitrary= A6Input <$> (choose (0, 8) >>= (`replicateM` arbitrary)) instance Arbitrary NetAddress where arbitrary = oneof [ NetAddress4 <$> arbitrary <*> mask4 , NetAddress6 <$> arbitrary <*> mask6 ] instance Arbitrary Cidr where arbitrary = oneof [ fromJust <$> (cidr4' <$> arbitrary <*> mask4) , fromJust <$> (cidr6' <$> arbitrary <*> mask6) ] isoProp :: Eq a => Printer a -> Parser a -> a -> Bool isoProp pr ps a = Right a == (evalParser ps $ execPrinter pr a) prop_v4HostAddressIso :: V4HostAddress -> Bool prop_v4HostAddressIso = isoProp Printer.v4HostAddress Parser.v4HostAddress prop_v6HostAddressIso :: V6HostAddress -> Bool prop_v6HostAddressIso = isoProp Printer.v6HostAddress Parser.v6HostAddress prop_v6HostAddressDcIsoL :: V6HostAddress -> Bool prop_v6HostAddressDcIsoL a6 = v6HostAddress [w0, w1, w2, w3, w4, w5, w6, w7] [] == Just a6 where (w0, w1, w2, w3, w4, w5, w6, w7) = v6HostAddressWords a6 prop_v6HostAddressDcIsoR :: V6HostAddress -> Bool prop_v6HostAddressDcIsoR a6 = v6HostAddress [] [w0, w1, w2, w3, w4, w5, w6, w7] == Just a6 where (w0, w1, w2, w3, w4, w5, w6, w7) = v6HostAddressWords a6 prop_v6HostAddressCons :: A6Input -> A6Input -> Bool prop_v6HostAddressCons (A6Input il) (A6Input ir) = case v6HostAddress il ir of Nothing -> length (il ++ ir) > 8 Just (V6HostAddress w0 w1 w2 w3 w4 w5 w6 w7) | let ws = [w0, w1, w2, w3, w4, w5, w6, w7] -> length (il ++ ir) <= 8 && il `isPrefixOf` ws && ir `isSuffixOf` ws prop_netAddressPpIso :: NetAddress -> Bool prop_netAddressPpIso = isoProp Printer.netAddress Parser.netAddress prop_netAddressDcIso :: NetAddress -> Bool prop_netAddressDcIso na = dc == Just na where dc = case na of NetAddress4 a4 m -> netAddress4 a4 m NetAddress6 a6 m -> netAddress6 a6 m prop_netAddress4Cons :: V4HostAddress -> Word8 -> Bool prop_netAddress4Cons a4 m = case netAddress4 a4 m of Nothing -> m > 32 Just (NetAddress4 a4' m') -> a4 == a4' && m == m' Just (NetAddress6 {}) -> False prop_netAddress6Cons :: V6HostAddress -> Word8 -> Bool prop_netAddress6Cons a6 m = case netAddress6 a6 m of Nothing -> m > 128 Just (NetAddress4 {}) -> False Just (NetAddress6 a6' m') -> a6 == a6' && m == m' prop_cidrDcIso :: Cidr -> Bool prop_cidrDcIso cidr@(Cidr na) = dc == Just cidr where dc = case na of NetAddress4 a4 m -> cidr4 a4 m NetAddress6 a6 m -> cidr6 a6 m prop_cidr4Cons :: V4HostAddress -> Word8 -> Bool prop_cidr4Cons a4 m = case cidr4 a4 m of Nothing -> m > 32 || case cidr4' a4 m of Nothing -> False Just (Cidr (NetAddress4 a4' m')) -> m' == m && a4' /= a4 Just (Cidr (NetAddress6 {})) -> False Just (Cidr (NetAddress4 a4' m')) -> m' == m && a4' == a4 Just (Cidr (NetAddress6 {})) -> False prop_cidr6Cons :: V6HostAddress -> Word8 -> Bool prop_cidr6Cons a6 m = case cidr6 a6 m of Nothing -> m > 128 || case cidr6' a6 m of Nothing -> False Just (Cidr (NetAddress4 {})) -> False Just (Cidr (NetAddress6 a6' m')) -> m' == m && a6' /= a6 Just (Cidr (NetAddress4 {})) -> False Just (Cidr (NetAddress6 a6' m')) -> m' == m && a6' == a6 tests :: [Test] tests = [ qcTest "v4 address iso - print parse" prop_v4HostAddressIso , qcTest "v6 address iso - print parse" prop_v6HostAddressIso , qcTest "v6 address iso - destruct construct-left" prop_v6HostAddressDcIsoL , qcTest "v6 address iso - destruct construct-right" prop_v6HostAddressDcIsoR , qcTest "v6 address construction" prop_v6HostAddressCons , qcTest "network address iso - print parse" prop_netAddressPpIso , qcTest "network address iso - destruct construct" prop_netAddressDcIso , qcTest "network address 4 construction" prop_netAddress4Cons , qcTest "network address 6 construction" prop_netAddress6Cons , qcTest "cidr iso - destruct construct" prop_cidrDcIso , qcTest "cidr-4 construction" prop_cidr4Cons , qcTest "cidr-6 construction" prop_cidr6Cons ] main :: IO () main = defaultMain tests text-postgresql-0.0.3.1/src/0000755000000000000000000000000013313350024014005 5ustar0000000000000000text-postgresql-0.0.3.1/src/Data/0000755000000000000000000000000013313350024014656 5ustar0000000000000000text-postgresql-0.0.3.1/src/Data/PostgreSQL/0000755000000000000000000000000013313350024016661 5ustar0000000000000000text-postgresql-0.0.3.1/src/Data/PostgreSQL/NetworkAddress.hs0000644000000000000000000001320013313350024022150 0ustar0000000000000000-- | -- Module : Data.PostgreSQL.NetworkAddress -- Copyright : 2015-2018 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- This module defines network-address types of PostgreSQL. -- http://www.postgresql.org/docs/current/static/datatype-net-types.html module Data.PostgreSQL.NetworkAddress ( -- * Definitions about inet and cidr types Inet (..), Cidr (..), cidr4, cidr4', cidr6, cidr6', -- * Definitions about the address type which is the pair of host-address and mask NetAddress (..), netAddress4, netAddress6, -- * Definitions about the host-address types V4HostAddress (..), v4HostAddressOctets, V6HostAddress (..), v6HostAddressLong, v6HostAddressWords, v6HostAddress, v6HostAddressL, v6HostAddressR, ) where import Control.Applicative (pure) import Control.Monad (guard) import Data.Word (Word8, Word16, Word32) import Data.Bits (shiftL, shiftR, (.&.), (.|.)) -- | Host address type along with IPv4 address bytes with IPv4 string order. data V4HostAddress = V4HostAddress !Word8 !Word8 !Word8 !Word8 deriving (Eq, Ord, Show, Read) v4HostAddressOctets :: V4HostAddress -> (Word8, Word8, Word8, Word8) v4HostAddressOctets (V4HostAddress a b c d) = (a, b, c, d) -- | Host address type along with IPv6 address words with IPv6 string order. -- Each 'Word16' value is host byte order. -- Host byte order is portable in programs on its own host. -- Network byte order is only needed, when communicating other hosts. data V6HostAddress = V6HostAddress !Word16 !Word16 !Word16 !Word16 !Word16 !Word16 !Word16 !Word16 deriving (Eq, Ord, Show, Read) v6HostAddressLong :: Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress v6HostAddressLong = V6HostAddress v6HostAddress :: [Word16] -> [Word16] -> Maybe V6HostAddress v6HostAddress ls rs = do let zlength = 8 {- v6 length -} - length (ls ++ rs) guard $ zlength >= 0 [a, b, c, d, e, f, g, h] <- pure $ ls ++ replicate zlength 0 ++ rs pure $ v6HostAddressLong a b c d e f g h v6HostAddressR :: [Word16] -> Maybe V6HostAddress v6HostAddressR = v6HostAddress [] v6HostAddressL :: [Word16] -> Maybe V6HostAddress v6HostAddressL ls = v6HostAddress ls [] v6HostAddressWords :: V6HostAddress -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16) v6HostAddressWords (V6HostAddress a b c d e f g h) = (a, b, c, d, e, f, g, h) -- | IPv4 or IPv6 netword address corresponding /. -- eg. '192.168.0.1/24' data NetAddress = NetAddress4 !V4HostAddress !Word8 | NetAddress6 !V6HostAddress !Word8 deriving (Eq, Ord, Show, Read) vmask4 :: (Ord a, Integral a) => a -> Bool vmask4 = (<= 32) -- | Make IPv4 NetAddress type consistent with IPv4 mask netAddress4 :: V4HostAddress -- ^ IPv4 host-address -> Word8 -- ^ IPv4 mask 0-32 -> Maybe NetAddress -- ^ result NetAddress netAddress4 a4 m | vmask4 m = Just $ NetAddress4 a4 m | otherwise = Nothing vmask6 :: (Ord a, Integral a) => a -> Bool vmask6 = (<= 128) -- | Make IPv6 NetAddress type consistent with IPv6 mask netAddress6 :: V6HostAddress -- ^ IPv6 host-address -> Word8 -- ^ IPv6 mask 0-128 -> Maybe NetAddress -- ^ result NetAddress netAddress6 a6 m | vmask6 m = Just $ NetAddress6 a6 m | otherwise = Nothing -- | Corresponding to INET type of PostgreSQL newtype Inet = Inet NetAddress deriving (Eq, Ord, Show, Read) -- | Corresponding to CIDR type of PostgreSQL newtype Cidr = Cidr NetAddress deriving (Eq, Ord, Show, Read) maskCidr4 :: V4HostAddress -> Word8 -> (Word32, Word32) maskCidr4 (V4HostAddress w0 w1 w2 w3) m = (a4 .&. (1 `shiftL` mi - 1) `shiftL` (32 - mi), a4) where mi = fromIntegral m a4 :: Word32 a4 = foldr (.|.) 0 $ zipWith (\w x -> fromIntegral w `shiftL` x) [w3, w2, w1, w0] [0,8 ..] -- | Same as cidr4 except for dropping host-address bits along with mask cidr4' :: V4HostAddress -> Word8 -> Maybe Cidr cidr4' ha0 m = do guard $ vmask4 m let (ra, _) = maskCidr4 ha0 m ha = fromList4 $ map (byte . (ra `shiftR`)) [24,16,8,0] return . Cidr $ NetAddress4 ha m where byte = fromIntegral . (.&. 0xff) fromList4 ws = V4HostAddress w0 w1 w2 w3 where [w0, w1, w2, w3] = ws -- | Make Cidr type of IPv4 from host-address bits consistent with mask cidr4 :: V4HostAddress -> Word8 -> Maybe Cidr cidr4 ha m = do na <- netAddress4 ha m let (ma, ra) = maskCidr4 ha m guard $ ma == ra return $ Cidr na maskCidr6 :: V6HostAddress -> Word8 -> (Integer, Integer) maskCidr6 (V6HostAddress w0 w1 w2 w3 w4 w5 w6 w7) m = (a6 .&. (1 `shiftL` mi - 1) `shiftL` (128 - mi), a6) where mi = fromIntegral m a6 :: Integer a6 = foldr (.|.) 0 $ zipWith (\w x -> fromIntegral w `shiftL` x) [w7, w6, w5, w4, w3, w2, w1, w0] [0,16 ..] -- | Same as cidr6 except for dropping host-address bits along with mask cidr6' :: V6HostAddress -> Word8 -> Maybe Cidr cidr6' ha0 m = do guard $ vmask6 m let (ra, _) = maskCidr6 ha0 m ha = fromList6 $ map (word . (ra `shiftR`)) [112, 96 .. 0] return . Cidr $ NetAddress6 ha m where word = fromIntegral . (.&. 0xffff) fromList6 ws = V6HostAddress w0 w1 w2 w3 w4 w5 w6 w7 where [w0, w1, w2, w3, w4, w5, w6, w7] = ws -- | Make Cidr type of IPv6 from host-address bits consistent with mask cidr6 :: V6HostAddress -> Word8 -> Maybe Cidr cidr6 ha m = do na <- netAddress6 ha m let (ma, ra) = maskCidr6 ha m guard $ ma == ra return $ Cidr na text-postgresql-0.0.3.1/src/Text/0000755000000000000000000000000013313350024014731 5ustar0000000000000000text-postgresql-0.0.3.1/src/Text/Printer/0000755000000000000000000000000013313350024016354 5ustar0000000000000000text-postgresql-0.0.3.1/src/Text/Printer/List.hs0000644000000000000000000000072413313350024017626 0ustar0000000000000000module Text.Printer.List ( PrintM, Printer, execPrinter , token, list ) where import Control.Monad.Trans.Writer (Writer, execWriter, tell) import Data.DList (DList) import qualified Data.DList as DList type PrintM t = Writer (DList t) type Printer t a = a -> PrintM t () token :: Printer t t token = tell . return list :: Printer t [t] list = mapM_ token execPrinter :: Printer t a -> a -> [t] execPrinter p = DList.toList . execWriter . p text-postgresql-0.0.3.1/src/Text/Parser/0000755000000000000000000000000013313350024016165 5ustar0000000000000000text-postgresql-0.0.3.1/src/Text/Parser/List.hs0000644000000000000000000000363713313350024017445 0ustar0000000000000000module Text.Parser.List ( Parser, runParser, evalParser , Error, errorE, errorP, noteP , token, eof, sink, satisfy', satisfy, list ) where import Control.Applicative (pure) import Control.Monad (guard) import Control.Monad.Trans.State.Strict (StateT (..), evalStateT, get, put) import Control.Monad.Trans.Except (Except, runExcept, withExcept, throwE) import Data.Monoid (Last (..)) import Data.Maybe (fromMaybe) type Error = Last String unError :: String -> Error -> String unError s = fromMaybe s . getLast type Parser t = StateT [t] (Except Error) runParser :: Parser t a -> [t] -> Either String (a, [t]) runParser p = runExcept . withExcept (unError "runParser: parse error.") . runStateT p evalParser :: Parser t a -> [t] -> Either String a evalParser p = runExcept . withExcept (unError "evalParser: parse error.") . evalStateT p errorE :: String -> Except Error a errorE = throwE . Last . Just errorP :: String -> Parser t a errorP = StateT . const . errorE noteP :: String -> Maybe a -> Parser t a noteP s = maybe (errorP s) pure token :: Parser t t token = do cs0 <- get case cs0 of c:cs -> do put cs pure c [] -> errorP "token: end of input" eof :: Parser t () eof = do cs <- get case cs of [] -> pure () _:_ -> errorP "eof: not empty input" sink :: Parser t [t] sink = do cs <- get put [] pure cs satisfy' :: String -- ^ Parser name to print when error -> (t -> String) -- ^ Function to build error string -> (t -> Bool) -- ^ Predicate to satisfy -> Parser t t -- ^ Result parser satisfy' n ef p = do c <- token noteP (n ++ ": " ++ ef c) . guard $ p c return c -- | make satisfy parser with monoid-empty error. satisfy :: (t -> Bool) -> Parser t t satisfy p = do c <- token guard $ p c -- expect empty error return c list :: Eq t => [t] -> Parser t [t] list = mapM (satisfy . (==)) text-postgresql-0.0.3.1/src/Database/0000755000000000000000000000000013313350024015511 5ustar0000000000000000text-postgresql-0.0.3.1/src/Database/PostgreSQL/0000755000000000000000000000000013313350024017514 5ustar0000000000000000text-postgresql-0.0.3.1/src/Database/PostgreSQL/Parser.hs0000644000000000000000000000704713313350024021314 0ustar0000000000000000 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 = satisfy' "digit" (const "must be digit.") isDigit hexDigit :: Parser Char hexDigit = satisfy' "hexDigit" (const "must be hex-digit.") isHexDigit readNat :: String -> Maybe Integer readNat s = listToMaybe [ i | (i, "") <- readDec s ] -- readDec accept only positive readHexNat :: String -> Maybe Integer readHexNat s = listToMaybe [ i | (i, "") <- readHex s ] nat :: Parser Integer nat = do xs <- some digit noteP "nat: invalid input" $ readNat xs hexNat :: Parser Integer hexNat = do xs <- some hexDigit noteP "hexNat: invalid input" $ readHexNat xs rangedNat :: (Integral a, Show a) => a -> a -> Integer -> Parser a rangedNat n x i = do noteP (concat ["rangedNat: out of range: ", show i, ": [", show n, ", ", show x, "]"]) . guard $ (fromIntegral n <= i && i <= fromIntegral x) pure $ fromIntegral i decW8 :: Parser Word8 decW8 = rangedNat minBound maxBound =<< nat hexW16 :: Parser Word16 hexW16 = rangedNat minBound maxBound =<< hexNat char :: Char -> Parser Char char c = satisfy (== c) dot :: Parser Char dot = char '.' colon :: Parser Char colon = char ':' slash :: Parser Char slash = char '/' v4HostAddress :: Parser V4HostAddress v4HostAddress = D.V4HostAddress <$> decW8 <* dot <*> decW8 <* dot <*> decW8 <* dot <*> decW8 _exampleHostAddress :: [Either String V4HostAddress] _exampleHostAddress = [ evalParser (v4HostAddress <* eof) s | s <- [ "0.0.0.0", "192.168.0.1" ] ] mask4bits :: Word8 mask4bits = 32 decMask4 :: Parser Word8 decMask4 = rangedNat 0 mask4bits =<< nat v6words :: Parser [Word16] v6words = (:) <$> hexW16 <*> many (colon *> hexW16) <|> pure [] doubleColon6 :: Parser V6HostAddress doubleColon6 = do m6 <- D.v6HostAddress <$> v6words <* replicateM 2 colon <*> v6words noteP "v6HostAddress: Too many numbers of 16-bit words." m6 v6HostAddress :: Parser V6HostAddress v6HostAddress = doubleColon6 <|> D.v6HostAddressLong <$> hexW16 <* colon <*> hexW16 <* colon <*> hexW16 <* colon <*> hexW16 <* colon <*> hexW16 <* colon <*> hexW16 <* colon <*> hexW16 <* colon <*> hexW16 _exampleHostAddress6 :: [Either String V6HostAddress] _exampleHostAddress6 = [ evalParser (v6HostAddress <* eof) s | s <- [ "::", "0:0:0:0:0:0:0:0", "2001:1::1:a2", "1:1:1:1:1:1:1:a1" ] ] mask6bits :: Word8 mask6bits = 128 decMask6 :: Parser Word8 decMask6 = rangedNat 0 mask6bits =<< nat optional' :: a -> Parser a -> Parser a optional' x p = fromMaybe x <$> optional p netAddress :: Parser NetAddress netAddress = NetAddress4 <$> v4HostAddress <*> optional' mask4bits (slash *> decMask4) <|> NetAddress6 <$> v6HostAddress <*> optional' mask6bits (slash *> decMask6) _exampleNetAddress :: [Either String NetAddress] _exampleNetAddress = [ evalParser (netAddress <* eof) s | s <- [ "2001:1::a0:a2/64", "172.16.0.0" ] ] text-postgresql-0.0.3.1/src/Database/PostgreSQL/Printer.hs0000644000000000000000000000252613313350024021500 0ustar0000000000000000 module Database.PostgreSQL.Printer ( Printer, execPrinter , v4HostAddress , v6HostAddress , netAddress ) where import Numeric (showInt, showHex) import Text.Printer.List (token, list, execPrinter) import qualified Text.Printer.List as P import Data.PostgreSQL.NetworkAddress (V4HostAddress, v4HostAddressOctets, V6HostAddress, v6HostAddressWords, NetAddress (..)) type Printer a = P.Printer Char a type PrintM = P.PrintM Char mapShowS :: (a -> ShowS) -> Printer a mapShowS s = list . ($ []) . s dec :: (Integral a, Show a) => Printer a dec = mapShowS showInt hex :: (Integral a, Show a) => Printer a hex = mapShowS showHex dot :: PrintM () dot = token '.' colon :: PrintM () colon = token ':' slash :: PrintM () slash = token '/' v4HostAddress :: Printer V4HostAddress v4HostAddress ha = do let (a, b, c, d) = v4HostAddressOctets ha dec a dot dec b dot dec c dot dec d v6HostAddress :: Printer V6HostAddress v6HostAddress ha = do let (a, b, c, d, e, f, g, h) = v6HostAddressWords ha hex a colon hex b colon hex c colon hex d colon hex e colon hex f colon hex g colon hex h netAddress :: Printer NetAddress netAddress = d where d (NetAddress4 ha m) = do v4HostAddress ha slash dec m d (NetAddress6 v6 m) = do v6HostAddress v6 slash dec m