construct 0.1 → 0.2

raw patch · 7 files changed

+148/−103 lines, 7 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−1
• construct.cabal +4/−4
• src/Construct.hs +32/−24
• test/OrphanInstances.hs +18/−0
• test/TAR.hs +1/−11
• test/Test.hs +27/−11
• test/URI.hs +56/−52

@@ -1,5 +1,14 @@ # Revision history for construct -## 0.1.0.0 -- YYYY-mm-dd+## 0.2 -- 2020-01-27++* Updated for `base-4.13`+* Eliminated the `Monoid/Semigroup (n s)` constraints+* Added `recordWith`+* Fixed the URI example and test+  * Constrained the URI format serialization to ByteString+  * Switched the URI parser to Attoparsec++## 0.1 -- 2020-01-22  * First version. Released on an unsuspecting world.

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                construct-version:             0.1+version:             0.2 synopsis:            Haskell version of the Construct library for easy specification of file formats description:    A Haskell version of the <https://construct.readthedocs.io/en/latest/intro.html Construct> library for Python. A@@ -28,7 +28,7 @@   hs-source-dirs:      src   exposed-modules:     Construct, Construct.Bits, Construct.Classes   other-modules:       Construct.Internal-  build-depends:       base >=4.11 && <4.13,+  build-depends:       base >=4.11 && <5,                        bytestring >= 0.10 && < 0.11,                        text >= 0.10 && < 1.3,                        monoid-subclasses >= 1.0 && < 1.1,@@ -56,12 +56,12 @@ test-suite             examples   type:                exitcode-stdio-1.0   hs-source-dirs:      test-  x-uses-tf:           true   build-depends:       base >=4.9 && < 5, construct,                        bytestring < 0.11, text < 1.3, cereal, rank2classes >= 1.0.2 && < 1.4,                        monoid-subclasses >= 1.0 && < 1.1, incremental-parser < 0.5, attoparsec >= 0.12 && < 0.14,                        directory < 2, filepath < 1.5,                        tasty >= 0.7, tasty-hunit   main-is:             Test.hs-  other-modules:       MBR, TAR, URI, WMF+  other-modules:       MBR, TAR, URI, WMF, OrphanInstances   default-language:    Haskell2010+  ghc-options:         -O0

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, RankNTypes, ScopedTypeVariables #-}  module Construct (@@ -9,7 +9,7 @@   (Construct.<$), (Construct.*>), (Construct.<*), (Construct.<|>), (<+>), (<?>),   empty, optional, optionWithDefault, pair, deppair, many, some, sepBy, count,   -- ** Self-referential record support-  mfix, record,+  mfix, record, recordWith,   -- ** Mapping over a 'Format'   mapSerialized, mapMaybeSerialized, mapValue, mapMaybeValue,   -- ** Constraining a 'Format'@@ -29,9 +29,11 @@ import Control.Monad.Fix (MonadFix) import Data.Functor ((<$>), void) import qualified Data.Functor.Const as Functor+import qualified Data.Functor.Identity as Functor import qualified Data.List as List import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe)+import Data.Monoid (Ap(Ap, getAp)) import Data.Semigroup (Semigroup, (<>), sconcat) import Data.Word (Word8) import Data.ByteString (ByteString)@@ -298,7 +300,7 @@ -- Right [(513,"\ETX")] cereal' get put = Format p (pure . runPut . put)    where p = go (runGetPartial get mempty)-            where go (Fail msg _) = fail msg+            where go (Fail msg _) = Parser.unexpected msg                   go (Done r _) = pure r                   go (Partial cont) = Input.anyToken >>= go . cont @@ -316,14 +318,21 @@    serialize = \as-> if length as == n then mconcat <$> traverse (serialize item) as                      else expectedName ("a list of length " ++ show n) (failure $ show as)} -record :: (Rank2.Apply g, Rank2.Traversable g, FixTraversable m, Monoid (n s), Applicative o, Foldable o) =>-          g (Format m n s) -> Format m n s (g o)+record :: (Rank2.Apply g, Rank2.Traversable g, FixTraversable m, Applicative n, Monoid s) =>+          g (Format m n s) -> Format m n s (g Functor.Identity) -- | Converts a record of field formats into a single format of the whole record.-record formats = Format{+record = recordWith Functor.runIdentity++recordWith :: forall g m n o s. (Rank2.Apply g, Rank2.Traversable g, FixTraversable m, Applicative n, Monoid s,+                                 Applicative o) =>+              (forall a. o (n a) -> n a) -> g (Format m n s) -> Format m n s (g o)+-- | Converts a record of field formats into a single format of the whole record, a generalized form of 'record'.+recordWith collapse formats = Format{    parse = Input.fixSequence (parse Rank2.<$> formats),-   serialize = Rank2.foldMap Functor.getConst . Rank2.liftA2 serializeField formats+   serialize = getAp . Rank2.foldMap Functor.getConst . Rank2.liftA2 serializeField formats    }-   where serializeField format xs = Functor.Const (foldMap (serialize format) xs)+   where serializeField :: forall a. Format m n s a -> o a -> Functor.Const (Ap n s) a+         serializeField format xs = Functor.Const (Ap $ collapse (serialize format <$> xs))  infixl 3 <|> infixl 4 <$@@ -336,17 +345,17 @@    parse = a Applicative.<$ parse f,    serialize = \b-> if a == b then serialize f () else expectedName (show a) (failure $ show b)} -(*>) :: (Applicative m, Semigroup (n s)) => Format m n s () -> Format m n s a -> Format m n s a+(*>) :: (Applicative m, Applicative n, Semigroup s) => Format m n s () -> Format m n s a -> Format m n s a -- | Same as the usual 'Applicative.*>' except a 'Format' is no 'Functor', let alone 'Applicative'. f1 *> f2 = Format{    parse = parse f1 Applicative.*> parse f2,-   serialize = \a-> serialize f1 () <> serialize f2 a}+   serialize = \a-> Applicative.liftA2 (<>) (serialize f1 ()) (serialize f2 a)} -(<*) :: (Applicative m, Semigroup (n s)) => Format m n s a -> Format m n s () -> Format m n s a+(<*) :: (Applicative m, Applicative n, Semigroup s) => Format m n s a -> Format m n s () -> Format m n s a -- | Same as the usual 'Applicative.<*' except a 'Format' is no 'Functor', let alone 'Applicative'. f1 <* f2 = Format{    parse = parse f1 Applicative.<* parse f2,-   serialize = \a-> serialize f1 a <> serialize f2 ()}+   serialize = \a-> Applicative.liftA2 (<>) (serialize f1 a) (serialize f2 ())}  (<|>) :: (Alternative m, Alternative n) => Format m n s a -> Format m n s a -> Format m n s a -- | Same as the usual 'Applicative.<|>' except a 'Format' is no 'Functor', let alone 'Alternative'.@@ -360,32 +369,31 @@    parse = Left <$> parse f1 Applicative.<|> Right <$> parse f2,    serialize = either (serialize f1) (serialize f2)} -optional :: (Alternative m, Alternative n, Monoid (n s)) => Format m n s a -> Format m n s (Maybe a)+optional :: (Alternative m, Alternative n, Monoid s) => Format m n s a -> Format m n s (Maybe a) -- | Same as the usual 'Applicative.optional' except a 'Format' is no 'Functor', let alone 'Alternative'. optional f = Format{    parse = Applicative.optional (parse f),-   serialize = maybe mempty (serialize f)}+   serialize = maybe (pure mempty) (serialize f)}  -- | Like 'optional' except with arbitrary default serialization for the @Nothing@ value. -- -- > optional = optionWithDefault (literal mempty)-optionWithDefault :: (Alternative m, Alternative n, Monoid (n s)) =>-                     Format m n s () -> Format m n s a -> Format m n s (Maybe a)+optionWithDefault :: (Alternative m, Alternative n) => Format m n s () -> Format m n s a -> Format m n s (Maybe a) optionWithDefault d f = Format{    parse = Just <$> parse f Applicative.<|> Nothing Applicative.<$ parse d,    serialize = maybe (serialize d ()) (serialize f)} -many :: (Alternative m, Monoid (n s)) => Format m n s a -> Format m n s [a]+many :: (Alternative m, Applicative n, Monoid s) => Format m n s a -> Format m n s [a] -- | Same as the usual 'Applicative.many' except a 'Format' is no 'Functor', let alone 'Alternative'. many f = Format{    parse = Applicative.many (parse f),-   serialize = foldMap (serialize f)}+   serialize = fmap mconcat . traverse (serialize f)} -some :: (Alternative m, AlternativeFail n, Semigroup (n s)) => Format m n s a -> Format m n s [a]+some :: (Alternative m, AlternativeFail n, Semigroup s) => Format m n s a -> Format m n s [a] -- | Same as the usual 'Applicative.some' except a 'Format' is no 'Functor', let alone 'Alternative'. some f = Format{    parse = Applicative.some (parse f),-   serialize = maybe (failure "[]") sconcat . nonEmpty . map (serialize f)}+   serialize = maybe (failure "[]") (fmap sconcat . traverse (serialize f)) . nonEmpty}  sepBy :: (Alternative m, Applicative n, Monoid s) => Format m n s a -> Format m n s () -> Format m n s [a] -- | Represents any number of values formatted using the first argument, separated by the second format argumewnt in@@ -397,16 +405,16 @@    parse = Parser.sepBy (parse format) (parse separator),    serialize = \xs-> mconcat <$> sequenceA (List.intersperse (serialize separator ()) $ serialize format <$> xs)} -pair :: (Applicative m, Semigroup (n s)) => Format m n s a -> Format m n s b -> Format m n s (a, b)+pair :: (Applicative m, Applicative n, Semigroup s) => Format m n s a -> Format m n s b -> Format m n s (a, b) -- | Combines two formats into a format for the pair of their values. -- -- >>> testParse (pair char char) "abc" -- Right [(('a','b'),"c")] pair f g = Format{    parse = (,) <$> parse f <*> parse g,-   serialize = \(a, b)-> serialize f a <> serialize g b}+   serialize = \(a, b)-> Applicative.liftA2 (<>) (serialize f a) (serialize g b)} -deppair :: (Monad m, Semigroup (n s)) => Format m n s a -> (a -> Format m n s b) -> Format m n s (a, b)+deppair :: (Monad m, Applicative n, Semigroup s) => Format m n s a -> (a -> Format m n s b) -> Format m n s (a, b) -- | Combines two formats, where the second format depends on the first value, into a format for the pair of their -- values.  Similar to '>>=' except 'Format' is no 'Functor' let alone 'Monad'. --@@ -416,7 +424,7 @@ -- Right [(('a','a'),"c")] deppair f g = Format{    parse = parse f >>= \a-> parse (g a) >>= \b-> return (a, b),-   serialize = \(a, b)-> serialize f a <> serialize (g a) b}+   serialize = \(a, b)-> Applicative.liftA2 (<>) (serialize f a) (serialize (g a) b)}  empty :: (Alternative m, Alternative n) => Format m n s a -- | Same as the usual 'Applicative.empty' except a 'Format' is no 'Functor', let alone 'Alternative'.

@@ -0,0 +1,18 @@+module OrphanInstances where++import Data.ByteString (ByteString)+import Data.Monoid.Textual (TextualMonoid)+import Data.Text.Encoding (encodeUtf8)+import qualified Data.Monoid.Textual+import qualified Data.ByteString.Char8 as ASCII++instance TextualMonoid ByteString where+   fromText = encodeUtf8+   singleton = ASCII.singleton+   splitCharacterPrefix = ASCII.uncons+   dropWhile _ = ASCII.dropWhile+   dropWhile_ _ = ASCII.dropWhile+   takeWhile _ = ASCII.takeWhile+   takeWhile_ _ = ASCII.takeWhile+   span _ = ASCII.span+   span_ _ = ASCII.span

@@ -18,6 +18,7 @@ import Data.Attoparsec.ByteString (Parser)  import Construct+import OrphanInstances  import Prelude hiding ((<$), (<*), (*>), take, takeWhile) @@ -139,17 +140,6 @@ sumOf header = ByteString.foldl' add 0 (fold $ serialize blankFormat header)    where add s b = s + fromIntegral b          blankFormat = record (fileHeaderRecord $ literal $ ASCII.replicate 8 ' ')--instance TextualMonoid ByteString where-   fromText = encodeUtf8-   singleton = ASCII.singleton-   splitCharacterPrefix = ASCII.uncons-   dropWhile _ = ASCII.dropWhile-   dropWhile_ _ = ASCII.dropWhile-   takeWhile _ = ASCII.takeWhile-   takeWhile_ _ = ASCII.takeWhile-   span _ = ASCII.span-   span_ _ = ASCII.span  $(Rank2.TH.deriveAll ''Archive) $(Rank2.TH.deriveAll ''File)

@@ -3,13 +3,13 @@ module Main where  import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as ASCII import Data.ByteString (ByteString) import Data.Functor.Identity (Identity) import Data.List (isSuffixOf)-import Data.Maybe (mapMaybe)+import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as Text-import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Numeric (showHex) import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath.Posix (combine)@@ -25,8 +25,11 @@ import qualified URI import qualified WMF +import Debug.Trace+ data TestFormat = forall f. TestFormat (Format (Parser ByteString) Maybe ByteString (f Identity))-                | forall f. LineFormat (Format (Parser Text) Maybe Text (f Identity))+                | forall f. LineFormat (Format (Parser ByteString) Maybe ByteString (f Identity))+                | forall f. AttoLineFormat (Format Atto.Parser Maybe ByteString (f Identity))                 | forall f. AttoFormat (Format Atto.Parser Maybe ByteString (f Identity))  main = exampleTree "" "test/examples" >>= defaultMain . testGroup "examples"@@ -41,30 +44,43 @@                  let format                         | ".mbr"  `isSuffixOf` path = TestFormat MBR.format                         | ".tar"  `isSuffixOf` path = AttoFormat TAR.archive-                        | ".uris" `isSuffixOf` path = LineFormat URI.uriReference+                        | ".uris" `isSuffixOf` path = AttoLineFormat URI.uriReference                         | ".wmf"  `isSuffixOf` path = TestFormat WMF.fileFormat-                     textLines = Text.lines (decodeUtf8 blob)                      roundTrip f t-                        | Text.null t = Just t+                        | ByteString.null t = Just t                         | [(structure, remainder)] <- Incremental.completeResults (Incremental.feedEof $                                                                                    Incremental.feed t $ parse f),-                          Text.null remainder = serialize f structure+                          ByteString.null remainder = serialize f structure                         | otherwise = Nothing+                     attoRoundTrip f t+                        | ByteString.null t = Just t+                        | Atto.Done remainder structure <- Atto.parse (parse f) t, ByteString.null remainder =+                             serialize f structure+                        | Atto.Partial i <- Atto.parse (parse f) t,+                          Atto.Done remainder structure <- i mempty, ByteString.null remainder = serialize f structure+                        | otherwise = Nothing                      Just blob'                         | TestFormat f <- format,                           [(structure, remainder)] <- Incremental.completeResults (Incremental.feedEof $                                                                                    Incremental.feed blob $ parse f) =                              (<> remainder) <$> serialize f structure-                        | LineFormat f <- format = Just (encodeUtf8 $ mconcat $ mapMaybe (roundTrip f) textLines)+                        | LineFormat f <- format = Just (mconcat+                                                         $ map ((<> "\n") . fromMaybe "???" . roundTrip f)+                                                         $ ASCII.lines blob)+                        | AttoLineFormat f <- format = Just (mconcat+                                                             $ map ((<> "\n") . fromMaybe "???" . attoRoundTrip f)+                                                             $ ASCII.lines blob)                         | AttoFormat f <- format,                           Atto.Done remainder structure <- Atto.parse (parse f) blob =                              (<> remainder) <$> serialize f structure                         | AttoFormat f <- format, Atto.Partial i <- Atto.parse (parse f) blob,                           Atto.Done remainder structure <- i mempty =                              (<> remainder) <$> serialize f structure-                 return . (:[]) . testCase path $ assertEqual "round-trip" (hex blob) (hex blob')+                 return . (:[]) . testCase path $ assertEqual "round-trip" (hex format blob) (hex format blob') -hex :: ByteString -> String-hex = ByteString.foldr (pad . flip showHex "") ""+hex :: TestFormat -> ByteString -> String+hex LineFormat{} = ASCII.unpack+hex AttoLineFormat{} = ASCII.unpack+hex _ = ByteString.foldr (pad . flip showHex "") ""    where pad [x] s = ['0', x] ++ s          pad [x, y] s = [x, y] ++ s

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving,+{-# LANGUAGE FlexibleInstances, LambdaCase, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving,              TemplateHaskell, TupleSections, TypeApplications #-}  module URI where@@ -7,7 +7,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as ASCII-import Data.Char (isAlpha, isAscii, isDigit, isHexDigit, chr, ord)+import Data.Char (isAlpha, isAlphaNum, isDigit, isHexDigit, chr, ord, toUpper) import Data.Foldable (fold) import Data.Functor.Identity (Identity, runIdentity) import qualified Data.List as List@@ -22,9 +22,10 @@ import Numeric (readHex, showHex) import Numeric.Natural (Natural) import qualified Rank2.TH-import Text.ParserCombinators.Incremental.LeftBiasedLocal (Parser)+import Data.Attoparsec.ByteString (Parser)  import Construct+import OrphanInstances  import Prelude hiding ((<$), (<*), (*>), take, takeWhile) @@ -42,55 +43,63 @@    port :: f (Maybe Word16)    } -data HostName t = IPv4address{getIPv4address :: [Word8]}-                | IPv6address{getIPv6address :: [Word16]}-                | IPvFuture {version :: Word,-                             address :: t}-                | RegisteredName{getRegisteredName :: t}+data HostName t = IPv4address [Word8]+                | IPv6address [Word16]+                | IPvFuture Word t+                | RegisteredName t+                deriving (Eq, Read, Show) -uriReference :: (Show t, TextualMonoid t) => Format (Parser t) Maybe t (UriReference t Identity)+deriving instance Show t => Show (UriReference t Identity)+deriving instance Show t => Show (Authority t Identity)++uriReference :: Format Parser Maybe ByteString (UriReference ByteString Identity) uriReference = record UriReference{-   scheme = optional (mapValue (uncurry (<>)) (Factorial.splitAt 1) $-                      pair (satisfy (any alpha . Textual.characterPrefix) $ take 1)-                           (takeCharsWhile schemeChar)-                      <* literal ":"),-   authority = optional $ record Authority{-        user = optional (takeCharsWhile userChar <* literal "@"),-        host = hostName,-        port = optional (mapValue fromIntegral fromIntegral $ satisfy (< 65536) $-                         literal ":" *> mapDec (takeCharsWhile1 digit))},  -- port = *DIGIT in spec?+   scheme = optional (uriScheme <* literal ":"),+   authority = optional (literal "//" *> uriAuthority),    path = encodedCharSequence pathChar `sepBy` literal "/",-   query = optional (literal "*" *> encodedCharSequence queryChar),+   query = optional (literal "?" *> encodedCharSequence queryChar),    fragment = optional (literal "#" *> encodedCharSequence fragmentChar)    } -hostName :: (Show t, TextualMonoid t) => Format (Parser t) Maybe t (HostName t)-hostName = mapValue IPv4address getIPv4address ipV4address+uriAuthority :: Format Parser Maybe ByteString (Authority ByteString Identity)+uriAuthority = record Authority{+        user = optional (takeCharsWhile userChar <* literal "@"),+        host = hostName,+        port = optional (mapValue fromIntegral fromIntegral $+                         satisfy (< 65536) $ literal ":" *> mapDec (takeCharsWhile1 isDigit))}  -- port = *DIGIT in spec?++uriScheme :: Format Parser Maybe ByteString ByteString+uriScheme = mapValue (uncurry (<>)) (Factorial.splitAt 1) $+            pair (satisfy (any isAlpha . Textual.characterPrefix) $ take 1) (takeCharsWhile schemeChar)+                      +hostName :: Format Parser Maybe ByteString (HostName ByteString)+hostName = mapMaybeValue (Just . IPv4address) (\case (IPv4address a)-> Just a; _ -> Nothing) ipV4address            <|> literal "["-               *> (mapValue IPv6address getIPv6address ipV6address-                    <|> mapValue (uncurry IPvFuture) (\ipf-> (version ipf, address ipf))-                                 (pair (literal "v" *> mapHex (takeCharsWhile1 hexDigit))-                                       (literal "." *> takeCharsWhile1 ipFutureChar)))+               *> (mapMaybeValue (Just . IPv6address) (\case (IPv6address a)-> Just a; _ -> Nothing) ipV6address+                    <|> mapMaybeValue (Just . uncurry IPvFuture) (\case (IPvFuture v a)-> Just (v, a); _ -> Nothing)+                                      (pair (literal "v" *> mapHex (takeCharsWhile1 hexDigit))+                                            (literal "." *> takeCharsWhile1 ipFutureChar)))                <* literal "]"-           <|> mapValue RegisteredName getRegisteredName (encodedCharSequence hostChar)+           <|> mapMaybeValue (Just . RegisteredName) (\case (RegisteredName a)-> Just a; _ -> Nothing)+                             (encodedCharSequence hostChar) -ipV4address :: forall t. (Show t, TextualMonoid t) => Format (Parser t) Maybe t [Word8]+ipV4address :: Format Parser Maybe ByteString [Word8] ipV4address = satisfy ((== 4) . length) (decOctet `sepBy` literal ".")    where decOctet = mapValue fromIntegral fromIntegral $                     satisfy (< 256) $ mapDec $-                    takeCharsWhile1 digit+                    takeCharsWhile1 isDigit -ipV6address :: (Show t, TextualMonoid t) => Format (Parser t) Maybe t [Word16]+ipV6address :: Format Parser Maybe ByteString [Word16] ipV6address = satisfy ((== 8) . length) $               mapValue fill shorten ipV6addressShort    where fill :: [Maybe Word16] -> [Word16]          shorten :: [Word16] -> [Maybe Word16]-         fill words = concatMap (maybe (replicate (8 - length words) 0) (:[])) words+         fill words = concatMap (maybe (replicate (9 - length words) 0) (:[])) words          shorten [] = []          shorten (0:0:words) = Nothing : map Just (dropWhile (== 0) words)          shorten (word:words) = Just word : shorten words -ipV6addressShort :: (Show t, TextualMonoid t) => Format (Parser t) Maybe t [Maybe Word16]+ipV6addressShort :: Format Parser Maybe ByteString [Maybe Word16] ipV6addressShort = satisfy zeroOrOneNothings $                    mapValue (uncurry (++)) (, []) $                    pair (optional h16 `sepBy` literal ":")@@ -105,18 +114,17 @@             where elisionCount = length (filter isNothing words)          h16 = mapHex $ satisfy ((<5) . Factorial.length) $ takeCharsWhile1 hexDigit -mapHex :: (Show t, TextualMonoid t, Integral n, Show n) => Format (Parser t) Maybe t t -> Format (Parser t) Maybe t n-mapDec :: (Show t, TextualMonoid t) => Format (Parser t) Maybe t t -> Format (Parser t) Maybe t Natural+mapHex :: (Integral n, Show n) =>+          Format Parser Maybe ByteString ByteString -> Format Parser Maybe ByteString n+mapDec :: Format Parser Maybe ByteString ByteString -> Format Parser Maybe ByteString Natural mapDec = mapValue (read . Textual.toString (error . show)) (fromString . show) mapHex = mapValue (fst . head . readHex . Textual.toString (error . show)) (fromString . flip showHex "") -alpha, digit, hexDigit, schemeChar, hostChar, userChar, ipFutureChar,+hexDigit, schemeChar, hostChar, userChar, ipFutureChar,    pathChar, queryChar, fragmentChar, unreserved, subDelim :: Char -> Bool -alpha c      = isAlpha c && isAscii c-digit c      = isAlpha c && isDigit c-hexDigit c   = isAlpha c && isHexDigit c-schemeChar c = (isAlpha c || isDigit c) && isAscii c || elem @[] c "+-."+hexDigit c   = isHexDigit c+schemeChar c = isAlphaNum c || elem @[] c "+-." ipFutureChar = userChar hostChar c   = unreserved c || subDelim c userChar c   = unreserved c || subDelim c || c == ':'@@ -124,26 +132,22 @@ queryChar c  = pathChar c || c == '/' || c == '?' fragmentChar = queryChar subDelim c   = elem @[] c "!$&'()*+,;="-unreserved c = isAscii c && (isAlpha c || isDigit c || elem @[] c "-._~")+unreserved c = isAlphaNum c || elem @[] c "-._~" -encodedCharSequence :: forall t. (Show t, TextualMonoid t) => (Char -> Bool) -> Format (Parser t) Maybe t t+encodedCharSequence :: (Char -> Bool) -> Format Parser Maybe ByteString ByteString encodedCharSequence predicate = mapValue concatSequence splitSequence $-                                many (takeCharsWhile predicate <+> percentEncoded)-   where concatSequence :: [Either t Char] -> t-         splitSequence :: t -> [Either t Char]-         percentEncoded :: Format (Parser t) Maybe t Char+                                many (takeCharsWhile1 predicate <+> percentEncoded)+   where concatSequence :: [Either ByteString Char] -> ByteString+         splitSequence :: ByteString -> [Either ByteString Char]+         percentEncoded :: Format Parser Maybe ByteString Char          concatSequence = mconcat . map (either id Textual.singleton)          splitSequence s = case Textual.splitCharacterPrefix s-            of Just ('#', rest)-                  | Just (hex1, rest1) <- Textual.splitCharacterPrefix rest,-                    Just (hex2, rest2) <- Textual.splitCharacterPrefix rest1 ->-                       Right (hexChar [hex1, hex2]) : splitSequence rest2-                  | otherwise -> []-               Just (c, _)+            of Just (c, t)                   | predicate c, (prefix, rest) <- Textual.span_ False predicate s -> Left prefix : splitSequence rest+                  | otherwise -> Right c : splitSequence t                _ -> []-         percentEncoded = mapValue hexChar (padLeft . (`showHex` "") . ord) $-                          literal "#" *> count 2 (satisfy hexDigit char)+         percentEncoded = mapValue hexChar (padLeft . map toUpper . (`showHex` "") . ord) $+                          literal "%" *> count 2 (satisfy hexDigit char)          hexChar = chr . fst . head . readHex          padLeft [c] = ['0', c]          padLeft cs = cs