mini 2.0.0.1 → 2.0.1.0

raw patch · 7 files changed

+949/−32 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• mini.cabal +4/−2
• src/Mini/Data/Graph.hs +1/−1
• src/Mini/Hash/Class.hs +3/−29
• src/Mini/String/URI.hs +826/−0
• src/Mini/String/UTF8.hs +97/−0
• src/Mini/Transformers/Parser.hs +10/−0

@@ -4,6 +4,14 @@ (!) Breaking change ``` +2.0.1.0 [2026-09-06]+--------------------+```+    Create Mini.String.URI+    Create Mini.String.UTF8+    transformers(parser): Add 'match'+```+ 2.0.0.1 [2026-08-03] -------------------- ```

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               mini-version:            2.0.0.1+version:            2.0.1.0 license:            MIT license-file:       LICENSE author:             Victor Wallsten <victor.wallsten@protonmail.com>@@ -10,7 +10,7 @@ synopsis:           Minimal essentials description:   Everyday essentials: data structures, primitive recursion, hashing, linear-  algebra, lenses, randomness, transformers, and parsing.+  algebra, lenses, randomness, string processing, transformers, and parsing.    Uncompromisingly light on dependencies. @@ -47,6 +47,8 @@     Mini.Optics.Lens     Mini.Random.Class     Mini.Random.SplitMix+    Mini.String.URI+    Mini.String.UTF8     Mini.Transformers.Class     Mini.Transformers.Either     Mini.Transformers.Maybe

@@ -237,7 +237,7 @@     (Map.insertWith (const (<>)) u mempty ies)     (Map.insertWith (const (<>)) u mempty oes) --- | Add edges from a vertex to another vertex in a graph+-- | Add an edge from a vertex to another vertex in a graph connect :: (Ord a) => a -> a -> Graph a -> Graph a connect u v (Graph ies oes) =   Graph

@@ -16,8 +16,6 @@   FiniteBits,   finiteBitSize,   shiftR,-  (.&.),-  (.|.),  ) import Data.Int (   Int,@@ -36,8 +34,8 @@ import Mini.Data.Array (   Array,  )-import Mini.Data.Recursion (-  bool,+import qualified Mini.String.UTF8 as UTF8 (+  encode,  ) import Prelude (   Bool,@@ -54,7 +52,6 @@   take,   ($),   (.),-  (<=),  )  -- Classes@@ -76,30 +73,7 @@   toBytes = enumToBytes  instance Hashable Char where-  toBytes = fmap fromIntegral . go . fromEnum-   where-    go c =-      bool-        ( bool-            ( bool-                [ 0xf0 .|. (c `shiftR` 18)-                , 0x80 .|. ((c `shiftR` 12) .&. 0x3f)-                , 0x80 .|. ((c `shiftR` 6) .&. 0x3f)-                , 0x80 .|. (c .&. 0x3f)-                ]-                [ 0xe0 .|. (c `shiftR` 12)-                , 0x80 .|. ((c `shiftR` 6) .&. 0x3f)-                , 0x80 .|. (c .&. 0x3f)-                ]-                $ c <= 0xffff-            )-            [ 0xc0 .|. (c `shiftR` 6)-            , 0x80 .|. (c .&. 0x3f)-            ]-            $ c <= 0x7ff-        )-        [c]-        $ c <= 0x7f+  toBytes = UTF8.encode  instance Hashable Int where   toBytes = finiteBitsIntegralToBytes

@@ -0,0 +1,826 @@+-- | An implementation of URI (RFC 3986): <https://doi.org/10.17487/RFC3986>+module Mini.String.URI (+  -- * Types+  URI (+    URI+  ),+  Authority (+    Authority+  ),+  Host (+    IPv4,+    IPv6,+    IPvF,+    RegName+  ),+  Path (+    Path+  ),+  Address (+    Address+  ),+  Fragment (+    Fragment+  ),+  Port (+    Port+  ),+  Query (+    Query+  ),+  Scheme (+    Scheme+  ),+  Segment (+    Segment+  ),+  UserInfo (+    UserInfo+  ),+  Version (+    Version+  ),++  -- * Parsers+  absoluteURI,+  genericURI,+  relativeURI,++  -- * Combinators+  relativeTo,++  -- * Encoding+  encode,+  decode,++  -- * Normalization+  normalizeCase,+  normalizeDots,+  normalizeEncoding,+) where++import Control.Applicative (+  empty,+  many,+  optional,+  some,+  (<|>),+ )+import Control.Monad (+  replicateM,+ )+import Data.Bits (+  shiftL,+  shiftR,+  (.&.),+  (.|.),+ )+import Data.Bool (+  Bool,+  bool,+ )+import Data.Char (+  digitToInt,+  toLower,+  toUpper,+ )+import Data.Functor.Identity (+  runIdentity,+ )+import Data.List (+  intercalate,+ )+import Data.Maybe (+  isJust,+ )+import Data.Word (+  Word8,+ )+import qualified Mini.String.UTF8 as UTF8 (+  decode,+  encode,+ )+import Mini.Transformers.Parser (+  ParserT,+  atMost,+  match,+  oneOf,+  option,+  range,+  reject,+  sat,+  string,+  symbol,+ )+import Prelude (+  Bool (+    False,+    True+  ),+  Char,+  Eq,+  Int,+  Maybe (+    Just,+    Nothing+  ),+  Monad,+  Ord,+  Show,+  String,+  concat,+  concatMap,+  drop,+  fmap,+  fromEnum,+  id,+  maybe,+  not,+  null,+  pure,+  reverse,+  show,+  toEnum,+  uncurry,+  ($),+  (&&),+  (*>),+  (+),+  (.),+  (<$),+  (<$>),+  (<*),+  (<*>),+  (<=),+  (<>),+  (>=),+  (>>=),+ )++-- Types++-- | An absolute, generic, or relative URI+data URI+  = URI+      (Maybe Scheme)+      (Maybe Authority)+      Path+      (Maybe Query)+      (Maybe Fragment)+  deriving (Eq, Ord)++instance Show URI where+  show (URI s a p q f) =+    maybe "" ((<> ":") . show) s+      <> maybe "" (("//" <>) . show) a+      <> show p+      <> maybe "" (("?" <>) . show) q+      <> maybe "" (("#" <>) . show) f++-- | The authority component of a URI+data Authority+  = -- | without the leading @"\/\/"@+    Authority (Maybe UserInfo) Host (Maybe Port)+  deriving (Eq, Ord)++instance Show Authority where+  show (Authority u h p) =+    maybe "" ((<> "@") . show) u+      <> show h+      <> maybe "" ((":" <>) . show) p++-- | The host component of an authority+data Host+  = IPv4 Address+  | IPv6 Address+  | IPvF Version Address+  | RegName Address+  deriving (Eq, Ord)++instance Show Host where+  show (IPv4 a) = show a+  show (IPv6 a) = show a+  show (IPvF v a) = "v" <> show v <> "." <> show a+  show (RegName a) = show a++-- | The path component of a URI+data Path+  = Path+      Bool+      -- ^ Leading slash+      [Segment]+      Bool+      -- ^ Trailing slash+  deriving (Eq, Ord)++instance Show Path where+  show (Path l segs t) =+    bool "" "/" l+      <> intercalate "/" (fmap show segs)+      <> bool "" "/" t++-- | The address of a host+newtype Address = Address String+  deriving (Eq, Ord)++instance Show Address where+  show (Address a) = a++-- | The fragment component of a URI+newtype Fragment+  = -- | without the leading @"#"@+    Fragment String+  deriving (Eq, Ord)++instance Show Fragment where+  show (Fragment f) = f++-- | The port component of an authority+newtype Port+  = -- | without the leading @":"@+    Port String+  deriving (Eq, Ord)++instance Show Port where+  show (Port p) = p++-- | The query component of a URI+newtype Query+  = -- | without the leading @"?"@+    Query String+  deriving (Eq, Ord)++instance Show Query where+  show (Query q) = q++-- | The scheme component of a URI+newtype Scheme+  = -- | without the trailing @":"@+    Scheme String+  deriving (Eq, Ord)++instance Show Scheme where+  show (Scheme s) = s++-- | A segment of a path+newtype Segment+  = -- | without any delimiting @"\/"@+    Segment String+  deriving (Eq, Ord)++instance Show Segment where+  show (Segment s) = s++-- | The userinfo component of an authority+newtype UserInfo+  = -- | without the trailing @"\@"@+    UserInfo String+  deriving (Eq, Ord)++instance Show UserInfo where+  show (UserInfo u) = u++-- | The version of a future IP+newtype Version+  = -- | without the leading @"v"@ and trailing @"."@+    Version String+  deriving (Eq, Ord)++instance Show Version where+  show (Version v) = v++-- Parsers++-- | Parse an absolute URI (a generic URI without a fragment)+absoluteURI :: (Monad m) => ParserT Char m URI+absoluteURI =+  ( \(AbsoluteURI_ s h q) ->+      let (a, p) = fromHierPart_ h+       in URI (Just $ Scheme s) a p (Query <$> q) Nothing+  )+    <$> absoluteURI_++-- | Parse a generic URI (an absolute URI with an optional fragment)+genericURI :: (Monad m) => ParserT Char m URI+genericURI =+  ( \(URI_ s h q f) ->+      let (a, p) = fromHierPart_ h+       in URI (Just $ Scheme s) a p (Query <$> q) (Fragment <$> f)+  )+    <$> uri_++-- | Parse a relative URI (a generic URI without a scheme)+relativeURI :: (Monad m) => ParserT Char m URI+relativeURI =+  ( \(RelativeRef_ r q f) ->+      let (a, p) = fromRelativePart_ r+       in URI Nothing a p (Query <$> q) (Fragment <$> f)+  )+    <$> relativeRef_++-- Combinators++-- | Resolve a reference @r@ relative to a base @b@ via @r \`relativeTo\` b@+relativeTo :: URI -> URI -> URI+relativeTo (URI s' a' p'@(Path l' segs' t') q' f') (URI s a p q _) =+  bool+    ( bool+        ( bool+            (URI s a (removeDots $ bool (merge p p') p' l') q' f')+            (URI s a p (bool q q' $ isJust q') f')+            $ null segs' && not l' && not t'+        )+        (URI s a' (removeDots p') q' f')+        $ isJust a'+    )+    (URI s' a' (removeDots p') q' f')+    $ isJust s'++-- Encoding++-- | Turn a character into a percent-encoded octet sequence in UTF-8 format+encode :: Char -> String+encode = concatMap (('%' :) . twoDigitHex) . UTF8.encode+ where+  twoDigitHex w = [hex $ w `shiftR` 4, hex $ w .&. 0x0f]+  hex n = toEnum . fromEnum . (+ n) . bool 0x37 0x30 $ n <= 9++-- | Parse a percent-encoded octet sequence in UTF-8 format into a character+decode :: (Monad m) => ParserT Char m Char+decode =+  next >>= \w0 ->+    maybe+      ( next >>= \w1 ->+          maybe+            ( next >>= \w2 ->+                maybe+                  ( next >>= \w3 ->+                      maybe+                        empty+                        pure+                        . runIdentity+                        $ match UTF8.decode [w0, w1, w2, w3]+                  )+                  pure+                  . runIdentity+                  $ match UTF8.decode [w0, w1, w2]+            )+            pure+            . runIdentity+            $ match UTF8.decode [w0, w1]+      )+      pure+      . runIdentity+      $ match UTF8.decode [w0]+ where+  next :: (Monad m) => ParserT Char m Word8+  next = do+    hi <- symbol '%' *> hexdig+    lo <- hexdig+    pure . toEnum $ (digitToInt hi `shiftL` 4) .|. digitToInt lo++-- Normalization++-- | Lowercase scheme and host components, and uppercase percent-encoded octets+normalizeCase :: URI -> URI+normalizeCase (URI s a p q f) =+  URI+    (ncScheme <$> s)+    (ncAuthority <$> a)+    (ncPath p)+    (ncQuery <$> q)+    (ncFragment <$> f)+ where+  ncScheme (Scheme s') = Scheme $ fmap toLower s'+  ncAuthority (Authority u h p') = Authority u (ncHost h) p'+  ncHost (IPv6 (Address addr)) = IPv6 . Address $ fmap toLower addr+  ncHost (IPvF (Version v) (Address addr)) =+    IPvF (Version $ fmap toLower v) (Address $ fmap toLower addr)+  ncHost (RegName (Address addr)) = RegName . Address $ go toLower addr+  ncHost h@(IPv4 _) = h+  ncPath (Path l segs t) =+    Path l (fmap (\(Segment seg) -> Segment $ go id seg) segs) t+  ncQuery (Query q') = Query $ go id q'+  ncFragment (Fragment f') = Fragment $ go id f'+  go z ('%' : h1 : h2 : rest) = '%' : toUpper h1 : toUpper h2 : go z rest+  go z (c : rest) = z c : go z rest+  go _ [] = []++-- | Remove dot segments+normalizeDots :: URI -> URI+normalizeDots (URI s a p q f) = URI s a (removeDots p) q f++-- | Decode percent-encoded octets that correspond to unreserved characters+normalizeEncoding :: URI -> URI+normalizeEncoding (URI s a p q f) =+  URI+    s+    (neAuthority <$> a)+    (nePath p)+    (neQuery <$> q)+    (neFragment <$> f)+ where+  neAuthority (Authority u h p') = Authority (neUserInfo <$> u) h p'+   where+    neUserInfo (UserInfo u') = UserInfo $ go u'+  nePath (Path l segs t) =+    Path+      l+      (fmap (\(Segment seg) -> Segment $ go seg) segs)+      t+  neQuery (Query q') = Query $ go q'+  neFragment (Fragment f') = Fragment $ go f'+  go ('%' : h1 : h2 : rest) =+    maybe ('%' : h1 : h2 : go rest) (: go rest)+      . maybe+        Nothing+        (runIdentity . match unreserved . pure)+      . runIdentity+      $ match decode ['%', h1, h2]+  go (c : rest) = c : go rest+  go [] = []++-- Syntax++-- URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]+data URI_ = URI_ String HierPart_ (Maybe String) (Maybe String)++uri_ :: (Monad m) => ParserT Char m URI_+uri_ =+  URI_+    <$> scheme+    <* symbol ':'+    <*> hierPart_+    <*> optional (symbol '?' *> query)+    <*> optional (symbol '#' *> fragment)++-- hier-part+--   = "//" authority path-abempty+--   / path-absolute+--   / path-rootless+--   / path-empty+data HierPart_+  = HierPartAbempty_ Authority_ [String]+  | HierPartAbsolute_ [String]+  | HierPartRootless_ [String]+  | HierPartEmpty_++hierPart_ :: (Monad m) => ParserT Char m HierPart_+hierPart_ =+  (HierPartAbempty_ <$> (string "//" *> authority_) <*> path_abempty)+    <|> (HierPartAbsolute_ <$> path_absolute)+    <|> (HierPartRootless_ <$> path_rootless)+    <|> (HierPartEmpty_ <$ path_empty)++-- absolute-URI = scheme ":" hier-part [ "?" query ]+data AbsoluteURI_ = AbsoluteURI_ String HierPart_ (Maybe String)++absoluteURI_ :: (Monad m) => ParserT Char m AbsoluteURI_+absoluteURI_ =+  AbsoluteURI_+    <$> scheme+    <* symbol ':'+    <*> hierPart_+    <*> optional (symbol '?' *> query)++-- relative-ref = relative-part [ "?" query ] [ "#" fragment ]+data RelativeRef_ = RelativeRef_ RelativePart_ (Maybe String) (Maybe String)++relativeRef_ :: (Monad m) => ParserT Char m RelativeRef_+relativeRef_ =+  RelativeRef_+    <$> relativePart_+    <*> optional (symbol '?' *> query)+    <*> optional (symbol '#' *> fragment)++-- relative-part+--   = "//" authority path-abempty+--   / path-absolute+--   / path-noscheme+--   / path-empty+data RelativePart_+  = RelativePartAbempty_ Authority_ [String]+  | RelativePartAbsolute_ [String]+  | RelativePartNoScheme_ [String]+  | RelativePartEmpty_++relativePart_ :: (Monad m) => ParserT Char m RelativePart_+relativePart_ =+  (RelativePartAbempty_ <$> (string "//" *> authority_) <*> path_abempty)+    <|> (RelativePartAbsolute_ <$> path_absolute)+    <|> (RelativePartNoScheme_ <$> path_noscheme)+    <|> (RelativePartEmpty_ <$ path_empty)++-- scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )+scheme :: (Monad m) => ParserT Char m String+scheme = (:) <$> alpha <*> many (alpha <|> digit <|> oneOf "+-.")++-- authority = [ userinfo "@" ] host [ ":" port ]+data Authority_ = Authority_ (Maybe String) Host_ (Maybe String)++authority_ :: (Monad m) => ParserT Char m Authority_+authority_ =+  Authority_+    <$> optional (userinfo <* symbol '@')+    <*> host_+    <*> optional (symbol ':' *> port)++-- userinfo = *( unreserved / pct-encoded / sub-delims / ":" )+userinfo :: (Monad m) => ParserT Char m String+userinfo =+  concat+    <$> many+      ( fmap pure unreserved+          <|> pct_encoded+          <|> fmap pure sub_delims+          <|> string ":"+      )++-- host = IP-literal / IPv4address / reg-name+data Host_+  = HostIPLiteral_ IPLiteral_+  | HostIPv4Address_ String+  | HostRegName_ String++host_ :: (Monad m) => ParserT Char m Host_+host_ =+  (HostIPLiteral_ <$> ipLiteral_)+    <|> (HostIPv4Address_ <$> ipv4address)+    <|> (HostRegName_ <$> reg_name)++-- port = *DIGIT+port :: (Monad m) => ParserT Char m String+port = many digit++-- IP-literal = "[" ( IPv6address / IPvFuture ) "]"+data IPLiteral_+  = IPLiteralIPv6Address_ String+  | IPLiteralIPvFuture_ IPvFuture_++ipLiteral_ :: (Monad m) => ParserT Char m IPLiteral_+ipLiteral_ =+  symbol '['+    *> ( (IPLiteralIPv6Address_ <$> ipv6address)+           <|> (IPLiteralIPvFuture_ <$> ipvFuture_)+       )+    <* symbol ']'++-- IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )+-- NOTE: ABNF strings are case-insensitive+data IPvFuture_ = IPvFuture_ String String++ipvFuture_ :: (Monad m) => ParserT Char m IPvFuture_+ipvFuture_ =+  IPvFuture_+    <$> (oneOf "vV" *> some hexdig <* symbol '.')+    <*> some (unreserved <|> sub_delims <|> symbol ':')++-- IPv6address+--   =                            6( h16 ":" ) ls32+--   /                       "::" 5( h16 ":" ) ls32+--   / [               h16 ] "::" 4( h16 ":" ) ls32+--   / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32+--   / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32+--   / [ *3( h16 ":" ) h16 ] "::"    h16 ":"   ls32+--   / [ *4( h16 ":" ) h16 ] "::"              ls32+--   / [ *5( h16 ":" ) h16 ] "::"              h16+--   / [ *6( h16 ":" ) h16 ] "::"+-- NOTE: parsing [     *n( h16 ":" ) h16 ]+--       as      [ h16 *n( ":" h16 )     ]+--       to avoid consuming part of "::"+ipv6address :: (Monad m) => ParserT Char m String+ipv6address =+  (fmap concat (replicateM 6 $ h16 <> string ":") <> ls32)+    <|> ( string "::"+            <> fmap concat (replicateM 5 $ h16 <> string ":")+            <> ls32+        )+    <|> ( option [] h16+            <> string "::"+            <> fmap concat (replicateM 4 $ h16 <> string ":")+            <> ls32+        )+    <|> ( option [] (h16 <> fmap concat (atMost 1 $ string ":" <> h16))+            <> string "::"+            <> fmap concat (replicateM 3 $ h16 <> string ":")+            <> ls32+        )+    <|> ( option [] (h16 <> fmap concat (atMost 2 $ string ":" <> h16))+            <> string "::"+            <> fmap concat (replicateM 2 $ h16 <> string ":")+            <> ls32+        )+    <|> ( option [] (h16 <> fmap concat (atMost 3 $ string ":" <> h16))+            <> string "::"+            <> h16+            <> string ":"+            <> ls32+        )+    <|> ( option [] (h16 <> fmap concat (atMost 4 $ string ":" <> h16))+            <> string "::"+            <> ls32+        )+    <|> ( option [] (h16 <> fmap concat (atMost 5 $ string ":" <> h16))+            <> string "::"+            <> h16+        )+    <|> ( option [] (h16 <> fmap concat (atMost 6 $ string ":" <> h16))+            <> string "::"+        )++-- h16 = 1*4HEXDIG+h16 :: (Monad m) => ParserT Char m String+h16 = range 1 4 hexdig++-- ls32 = ( h16 ":" h16 ) / IPv4address+ls32 :: (Monad m) => ParserT Char m String+ls32 = (h16 <> string ":" <> h16) <|> ipv4address++-- IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet+ipv4address :: (Monad m) => ParserT Char m String+ipv4address =+  dec_octet+    <> string "."+    <> dec_octet+    <> string "."+    <> dec_octet+    <> string "."+    <> dec_octet++-- dec-octet+--   = DIGIT+--   / %x31-39 DIGIT+--   / "1" 2DIGIT+--   / "2" %x30-34 DIGIT+--   / "25" %x30-35+-- NOTE: ordered by descending length below+--       to avoid stopping early+dec_octet :: (Monad m) => ParserT Char m String+dec_octet =+  (string "1" <> replicateM 2 digit)+    <|> (string "2" <> fmap pure (octetRange (0x30, 0x34)) <> fmap pure digit)+    <|> (string "25" <> fmap pure (octetRange (0x30, 0x35)))+    <|> (fmap pure (octetRange (0x31, 0x39)) <> fmap pure digit)+    <|> (fmap pure digit)++-- reg-name = *( unreserved / pct-encoded / sub-delims )+reg_name :: (Monad m) => ParserT Char m String+reg_name =+  concat+    <$> many (fmap pure unreserved <|> pct_encoded <|> fmap pure sub_delims)++-- path-abempty = *( "/" segment )+path_abempty :: (Monad m) => ParserT Char m [String]+path_abempty = many (symbol '/' *> segment)++-- path-absolute = "/" [ segment-nz *( "/" segment ) ]+path_absolute :: (Monad m) => ParserT Char m [String]+path_absolute =+  symbol '/' *> option [] ((:) <$> segment_nz <*> many (symbol '/' *> segment))++-- path-noscheme = segment-nz-nc *( "/" segment )+path_noscheme :: (Monad m) => ParserT Char m [String]+path_noscheme = (:) <$> segment_nz_nc <*> many (symbol '/' *> segment)++-- path-rootless = segment-nz *( "/" segment )+path_rootless :: (Monad m) => ParserT Char m [String]+path_rootless = (:) <$> segment_nz <*> many (symbol '/' *> segment)++-- path-empty = 0<pchar>+path_empty :: (Monad m) => ParserT Char m [String]+path_empty = [] <$ reject pchar++-- segment = *pchar+segment :: (Monad m) => ParserT Char m String+segment = concat <$> many pchar++-- segment-nz = 1*pchar+segment_nz :: (Monad m) => ParserT Char m String+segment_nz = concat <$> some pchar++-- segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" )+segment_nz_nc :: (Monad m) => ParserT Char m String+segment_nz_nc =+  concat+    <$> some+      ( fmap pure unreserved+          <|> pct_encoded+          <|> fmap pure sub_delims+          <|> string "@"+      )++-- pchar = unreserved / pct-encoded / sub-delims / ":" / "@"+pchar :: (Monad m) => ParserT Char m String+pchar =+  fmap pure unreserved+    <|> pct_encoded+    <|> fmap pure sub_delims+    <|> string ":"+    <|> string "@"++-- query = *( pchar / "/" / "?" )+query :: (Monad m) => ParserT Char m String+query = concat <$> many (pchar <|> string "/" <|> string "?")++-- fragment = *( pchar / "/" / "?" )+fragment :: (Monad m) => ParserT Char m String+fragment = concat <$> many (pchar <|> string "/" <|> string "?")++-- pct-encoded = "%" HEXDIG HEXDIG+pct_encoded :: (Monad m) => ParserT Char m String+pct_encoded = string "%" <> replicateM 2 hexdig++-- unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"+unreserved :: (Monad m) => ParserT Char m Char+unreserved = alpha <|> digit <|> oneOf "-._~"++-- sub-delims = "!" / "$" / "&" / "'" / "(" / ")" / "*" / "+" / "," / ";" / "="+sub_delims :: (Monad m) => ParserT Char m Char+sub_delims = oneOf "!$&'()*+,;="++-- ALPHA = %x41-5A / %x61-7A+alpha :: (Monad m) => ParserT Char m Char+alpha = octetRange (0x41, 0x5A) <|> octetRange (0x61, 0x7A)++-- DIGIT = %x30-39+digit :: (Monad m) => ParserT Char m Char+digit = octetRange (0x30, 0x39)++-- HEXDIG = DIGIT / "A" / "B" / "C" / "D" / "E" / "F"+-- NOTE: ABNF strings are case-insensitive+hexdig :: (Monad m) => ParserT Char m Char+hexdig = digit <|> oneOf (['A' .. 'F'] <> ['a' .. 'f'])++-- Helpers++octetRange :: (Monad m) => (Int, Int) -> ParserT Char m Char+octetRange (lo, hi) = sat $ (\n -> n >= lo && n <= hi) . fromEnum++fromHierPart_ :: HierPart_ -> (Maybe Authority, Path)+fromHierPart_ (HierPartAbempty_ a segs) =+  (Just $ fromAuthority_ a, bool (mkAbsolute segs) mkEmpty $ null segs)+fromHierPart_ (HierPartAbsolute_ segs) = (Nothing, mkAbsolute segs)+fromHierPart_ (HierPartRootless_ segs) = (Nothing, mkRootless segs)+fromHierPart_ HierPartEmpty_ = (Nothing, mkEmpty)++fromAuthority_ :: Authority_ -> Authority+fromAuthority_ (Authority_ u h p) =+  Authority+    (UserInfo <$> u)+    ( case h of+        HostIPLiteral_ (IPLiteralIPv6Address_ addr) -> IPv6 (Address addr)+        HostIPLiteral_ (IPLiteralIPvFuture_ (IPvFuture_ v addr)) ->+          IPvF (Version v) (Address addr)+        HostIPv4Address_ addr -> IPv4 (Address addr)+        HostRegName_ addr -> RegName (Address addr)+    )+    (Port <$> p)++fromRelativePart_ :: RelativePart_ -> (Maybe Authority, Path)+fromRelativePart_ (RelativePartAbempty_ a segs) =+  (Just $ fromAuthority_ a, bool (mkAbsolute segs) mkEmpty $ null segs)+fromRelativePart_ (RelativePartAbsolute_ segs) =+  (Nothing, mkAbsolute segs)+fromRelativePart_ (RelativePartNoScheme_ segs) =+  (Nothing, mkRootless segs)+fromRelativePart_ RelativePartEmpty_ = (Nothing, mkEmpty)++mkEmpty :: Path+mkEmpty = Path False [] False++mkAbsolute :: [String] -> Path+mkAbsolute ("" : []) = Path True [] False -- edge case: path_abempty "/"+mkAbsolute segs = mkPath (Path True) segs++mkRootless :: [String] -> Path+mkRootless = mkPath (Path False)++mkPath :: ([Segment] -> Bool -> Path) -> [String] -> Path+mkPath c = uncurry c . go+ where+  go ("" : []) = ([], True)+  go (x : xs) =+    let (xs', t) = go xs+     in (Segment x : xs', t)+  go [] = ([], False)++merge :: Path -> Path -> Path+merge (Path l segs t) (Path _ segs' t') =+  bool+    (Path l (bool (go segs segs') (segs <> segs') t) t')+    (Path False segs' t')+    $ null segs && not l && not t+ where+  go (_ : []) xs' = xs'+  go (x : xs) xs' = x : go xs xs'+  go [] xs' = xs'++removeDots :: Path -> Path+removeDots (Path l segs t) = uncurry (Path l) $ go [] segs+ where+  go os (Segment "." : []) = (reverse os, not $ null os)+  go os (Segment "." : is) = go os is+  go os (Segment ".." : []) = (reverse $ drop 1 os, not . null $ drop 1 os)+  go os (Segment ".." : is) = go (drop 1 os) is+  go os (i : is) = go (i : os) is+  go os [] = (reverse os, t)

@@ -0,0 +1,97 @@+-- | An implementation of UTF-8 (RFC 3629): <https://doi.org/10.17487/RFC3629>+module Mini.String.UTF8 (+  encode,+  decode,+) where++import Control.Applicative (+  (<|>),+ )+import Data.Bits (+  complement,+  shiftL,+  shiftR,+  (.&.),+  (.|.),+ )+import Data.Bool (+  bool,+ )+import Data.Word (+  Word8,+ )+import Mini.Transformers.Parser (+  ParserT,+  sat,+ )+import Prelude (+  Char,+  Monad,+  fmap,+  fromEnum,+  fromIntegral,+  pure,+  toEnum,+  ($),+  (.),+  (<$>),+  (==),+  (||),+ )++-- | Turn a character into a byte sequence in UTF-8 format+encode :: Char -> [Word8]+encode = fmap fromIntegral . go . fromEnum+ where+  go n =+    bool+      ( bool+          ( bool+              [ 0xf0 .|. (n `shiftR` 18)+              , 0x80 .|. ((n `shiftR` 12) .&. 0x3f)+              , 0x80 .|. ((n `shiftR` 6) .&. 0x3f)+              , 0x80 .|. (n .&. 0x3f)+              ] -- up to 21 bits 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx+              [ 0xe0 .|. (n `shiftR` 12)+              , 0x80 .|. ((n `shiftR` 6) .&. 0x3f)+              , 0x80 .|. (n .&. 0x3f)+              ] -- up to 16 bits 1110xxxx 10xxxxxx 10xxxxxx+              $ n .&. complement 0xffff == 0+          )+          [ 0xc0 .|. (n `shiftR` 6)+          , 0x80 .|. (n .&. 0x3f)+          ] -- up to 11 bits 110xxxxx 10xxxxxx+          $ n .&. complement 0x7ff == 0+      )+      [n] -- up to 7 bits 0xxxxxxx+      $ n .&. complement 0x7f == 0++-- | Parse a byte sequence in UTF-8 format into a character+decode :: (Monad m) => ParserT Word8 m Char+decode = toEnum <$> (one <|> two <|> three <|> four)+ where+  one = mask 0x80+  two = do+    w0 <- mask 0xe0+    w1 <- next+    pure $ ((w0 .&. 0x1f) `shiftL` 6) .|. w1+  three = do+    w0 <- mask 0xf0+    w1 <- next+    w2 <- next+    let n = ((w0 .&. 0x0f) `shiftL` 12) .|. (w1 `shiftL` 6) .|. w2+    pure . bool n 0xfffd $ -- decode into replacement character U+FFFD for+      (n .&. complement 0x7ff == 0xd800) -- surrogates U+D800..U+DFFF+        || (n .&. complement 0x1 == 0xfffe) -- noncharacters U+FFFE and U+FFFF+  four = do+    w0 <- mask 0xf8+    w1 <- next+    w2 <- next+    w3 <- next+    pure $+      ((w0 .&. 0x07) `shiftL` 18)+        .|. (w1 `shiftL` 12)+        .|. (w2 `shiftL` 6)+        .|. w3+  mask m = fromEnum <$> sat (\w -> w .&. m == m `shiftL` 1)+  next = (.&. 0x3f) <$> mask 0xc0

@@ -5,6 +5,7 @@     ParserT   ),   runParserT,+  match,    -- * Parsers   eof,@@ -96,6 +97,7 @@   maybe,   mempty,   notElem,+  null,   pure,   traverse,   ($),@@ -119,6 +121,14 @@   { runParserT :: [s] -> m (Maybe (a, [s]))   -- ^ Unwrap a transformer computation with a sequence of symbols to parse   }++-- | Unwrap a transformer computation with a sequence of symbols to fully parse+match :: (Functor m) => ParserT s m a -> [s] -> m (Maybe a)+match p ss =+  maybe+    Nothing+    (\(a, ss') -> bool Nothing (Just a) $ null ss')+    <$> runParserT p ss  instance (Monad m) => Functor (ParserT s m) where   fmap = liftM