text-postgresql-0.0.2.1/0000755000000000000000000000000012731434442013227 5ustar0000000000000000text-postgresql-0.0.2.1/text-postgresql.cabal0000644000000000000000000000337112731434442017404 0ustar0000000000000000name: text-postgresql version: 0.0.2.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-2016 Kei Hibino category: Database build-type: Simple cabal-version: >=1.10 tested-with: GHC == 8.0.1 , 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: Control.Monad.Either.Plus Text.Parser.List Text.Printer.List build-depends: base <5 , transformers , dlist hs-source-dirs: src default-language: Haskell2010 test-suite pp build-depends: base <5 , QuickCheck , quickcheck-simple , text-postgresql type: exitcode-stdio-1.0 main-is: ppIso.hs hs-source-dirs: test ghc-options: -Wall default-language: Haskell2010 text-postgresql-0.0.2.1/Setup.hs0000644000000000000000000000005612731434442014664 0ustar0000000000000000import Distribution.Simple main = defaultMain text-postgresql-0.0.2.1/LICENSE0000644000000000000000000000275612731434442014246 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.2.1/src/0000755000000000000000000000000012731434442014016 5ustar0000000000000000text-postgresql-0.0.2.1/src/Data/0000755000000000000000000000000012731434442014667 5ustar0000000000000000text-postgresql-0.0.2.1/src/Data/PostgreSQL/0000755000000000000000000000000012731434442016672 5ustar0000000000000000text-postgresql-0.0.2.1/src/Data/PostgreSQL/NetworkAddress.hs0000644000000000000000000000460212731434442022167 0ustar0000000000000000-- | -- Module : Data.PostgreSQL.NetworkAddress -- Copyright : 2015 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 ( NetAddress (..) , V4HostAddress (..), v4HostAddressOctets , V6HostAddress (..), v6HostAddressLong, v6HostAddressWords , v6HostAddress, v6HostAddressL, v6HostAddressR , Inet (..), Cidr (..) ) where import Control.Applicative (pure) import Control.Monad (guard) import Data.Word (Word8, Word16) -- | Host address type along with IPv4 address string. data V4HostAddress = V4HostAddress !Word8 !Word8 !Word8 !Word8 deriving (Eq, Ord, Show) v4HostAddressOctets :: V4HostAddress -> (Word8, Word8, Word8, Word8) v4HostAddressOctets (V4HostAddress a b c d) = (a, b, c, d) -- | Host address type along with IPv6 address string. -- 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) v6HostAddressLong :: Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> V6HostAddress v6HostAddressLong = V6HostAddress v6HostAddress :: [Word16] -> [Word16] -> Maybe V6HostAddress v6HostAddress ls rs = do let v6length = 8 guard . null . drop v6length $ ls ++ rs [a, b, c, d, e, f, g, h] <- pure $ ls ++ replicate (v6length - length ls - length rs) 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) data NetAddress = NetAddress4 !V4HostAddress !Word8 | NetAddress6 !V6HostAddress !Word8 deriving (Eq, Ord, Show) newtype Inet = Inet NetAddress deriving (Eq, Ord, Show) newtype Cidr = Cidr NetAddress deriving (Eq, Ord, Show) text-postgresql-0.0.2.1/src/Database/0000755000000000000000000000000012731434442015522 5ustar0000000000000000text-postgresql-0.0.2.1/src/Database/PostgreSQL/0000755000000000000000000000000012731434442017525 5ustar0000000000000000text-postgresql-0.0.2.1/src/Database/PostgreSQL/Parser.hs0000644000000000000000000000704712731434442021325 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.2.1/src/Database/PostgreSQL/Printer.hs0000644000000000000000000000252612731434442021511 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 text-postgresql-0.0.2.1/src/Text/0000755000000000000000000000000012731434442014742 5ustar0000000000000000text-postgresql-0.0.2.1/src/Text/Parser/0000755000000000000000000000000012731434442016176 5ustar0000000000000000text-postgresql-0.0.2.1/src/Text/Parser/List.hs0000644000000000000000000000361012731434442017445 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 Data.Monoid (Last (..)) import Data.Maybe (fromMaybe) import Control.Monad.Either.Plus (EitherP (..), emap, leftP) type Error = Last String unError :: String -> Error -> String unError s = fromMaybe s . getLast type Parser t = StateT [t] (EitherP Error) runParser :: Parser t a -> [t] -> Either String (a, [t]) runParser p = unEitherP . emap (unError "runParser: parse error.") . runStateT p evalParser :: Parser t a -> [t] -> Either String a evalParser p = unEitherP . emap (unError "evalParser: parse error.") . evalStateT p errorE :: String -> EitherP Error a errorE = leftP . 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.2.1/src/Text/Printer/0000755000000000000000000000000012731434442016365 5ustar0000000000000000text-postgresql-0.0.2.1/src/Text/Printer/List.hs0000644000000000000000000000072412731434442017637 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.2.1/src/Control/0000755000000000000000000000000012731434442015436 5ustar0000000000000000text-postgresql-0.0.2.1/src/Control/Monad/0000755000000000000000000000000012731434442016474 5ustar0000000000000000text-postgresql-0.0.2.1/src/Control/Monad/Either/0000755000000000000000000000000012731434442017714 5ustar0000000000000000text-postgresql-0.0.2.1/src/Control/Monad/Either/Plus.hs0000644000000000000000000000247312731434442021201 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} module Control.Monad.Either.Plus ( EitherP (..) , eitherP, emap , leftP, rightP ) where import Control.Applicative ((<$>), Applicative (..), Alternative (..)) import Control.Monad (MonadPlus (..)) import Data.Monoid (Monoid (..), (<>)) newtype EitherP e a = EitherP { unEitherP :: Either e a } eitherP :: (a -> c) -> (b -> c) -> EitherP a b -> c eitherP f g = either f g . unEitherP emap :: (e0 -> e1) -> EitherP e0 a -> EitherP e1 a emap f = EitherP . eitherP (Left . f) Right leftP :: e -> EitherP e a leftP = EitherP . Left rightP :: a -> EitherP e a rightP = EitherP . Right instance Functor (EitherP e) where fmap f (EitherP e) = EitherP $ f <$> e instance Applicative (EitherP e) where pure = EitherP . pure EitherP a <*> EitherP b = EitherP $ a <*> b instance Monad (EitherP e) where (EitherP e) >>= f = EitherP (e >>= unEitherP . f) return = EitherP . return instance Monoid e => Alternative (EitherP e) where empty = EitherP $ Left mempty EitherP a <|> EitherP b = EitherP $ a `plus` b where x@(Right _) `plus` _ = x Left _ `plus` y@(Right _) = y Left e1 `plus` Left e2 = Left $ e1 <> e2 instance Monoid e => MonadPlus (EitherP e) where mzero = empty mplus = (<|>) text-postgresql-0.0.2.1/test/0000755000000000000000000000000012731434442014206 5ustar0000000000000000text-postgresql-0.0.2.1/test/ppIso.hs0000644000000000000000000000345312731434442015641 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} {--# LANGUAGE FlexibleInstances #--} import Test.QuickCheck (Gen, Arbitrary (..), choose, oneof) import Test.QuickCheck.Simple (defaultMain, Test, qcTest) import Control.Applicative ((<$>), (<*>)) import Data.Word (Word8) 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) instance Arbitrary NetAddress where arbitrary = oneof [ NetAddress4 <$> arbitrary <*> mask4 , NetAddress6 <$> 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_netAddressIso :: NetAddress -> Bool prop_netAddressIso = isoProp Printer.netAddress Parser.netAddress tests :: [Test] tests = [ qcTest "v4 address iso - print parse" prop_v4HostAddressIso , qcTest "v6 address iso - print parse" prop_v6HostAddressIso , qcTest "network address iso - print parse" prop_netAddressIso ] main :: IO () main = defaultMain tests