| By | ~fr33domlover |
| At | 2019-01-05 |
| Title | Add functions for using compact URIs and RelNoAuth |
| Description |
Edit file src/Network/IRI.hs 0 → 0
- 220 compactURIPrefix :: CompactURI -> ByteString
- 221 compactURIPrefix (CompactURI (Prefix b) _) = b
+ 220 compactURIPrefix :: CompactURI -> RelNoAuth
+ 221 compactURIPrefix (CompactURI (Prefix b) _) = RelNoAuth
+ 222 { rnaHierarchy = HierarchyRootless $ PathSegment (decodeUtf8 b) :| []+ 223 , rnaQuery = Nothing
+ 224 , rnaFragment = Nothing
+ 225 }
… … … … - 424 compactURI :: ByteString -> URI Gen -> URI Gen -> Maybe CompactURI
- 425 compactURI p (URI bs bh bq bf) (URI us uh uq uf) = do
- 426 p' <- parseOnly' prefix p
+ 428 splitURI :: URI Gen -> URI Gen -> Maybe RelNoAuth
+ 429 splitURI (URI bs bh bq bf) (URI us uh uq uf) = do
… … … … - 448 CompactURI p' <$>
- 449 case h of
- 450 HierarchyEmpty ->
- 451 case (bq, bf, uq, uf) of
- 452 (Nothing, Nothing, _, _) -> do
- 453 guard $ isJust uq || isJust uf
- 454 Just $ RelNoAuth h uq uf
- 455 (_, Just (Fragment f), _, Just (Fragment f')) -> do
- 456 guard $ bq == uq
- 457 s <- T.stripPrefix f f'
- 458 guard $ not $ T.null s
- 459 parseOnly' relativeNoAuth $
+ 451 case h of
+ 452 HierarchyEmpty ->
+ 453 case (bq, bf, uq, uf) of
+ 454 (Nothing, Nothing, _, _) -> do
+ 455 guard $ isJust uq || isJust uf
+ 456 Just $ RelNoAuth h uq uf
+ 457 (_, Just (Fragment f), _, Just (Fragment f')) -> do
+ 458 guard $ bq == uq
+ 459 s <- T.stripPrefix f f'
+ 460 guard $ not $ T.null s
+ 461 parseOnly' relativeNoAuth $
+ 462 percentEncode queryOrFragmentChar s
+ 463 (Just (Query q), Nothing, Just (Query q'), _) -> do
+ 464 s <- T.stripPrefix q q'
+ 465 when (isNothing uf) $ guard $ not $ T.null s
+ 466 (r, mq) <-
+ 467 parseOnly' rel $
- 466 (Just (Query q), Nothing, Just (Query q'), _) -> do
- 467 s <- T.stripPrefix q q'
- 468 when (isNothing uf) $ guard $ not $ T.null s
- 469 (r, mq) <-
- 470 parseOnly' rel $
- 471 percentEncode queryOrFragmentChar s
- 472 Just $ RelNoAuth r mq uf
- 473 where
- 474 rel = (,)
- 475 <$> relativePartNoAuth
- 476 <*> optional (char '?' *> query)
- 477 _ -> Nothing
- 478 _ -> do
- 479 guard $ isNothing bq && isNothing bf
- 480 Just $ RelNoAuth h uq uf
+ 474 Just $ RelNoAuth r mq uf
+ 475 where
+ 476 rel = (,)
+ 477 <$> relativePartNoAuth
+ 478 <*> optional (char '?' *> query)
+ 479 _ -> Nothing
+ 480 _ -> do
+ 481 guard $ isNothing bq && isNothing bf
+ 482 Just $ RelNoAuth h uq uf
… … … … - 502 parseCompactURI :: ByteString -> Maybe CompactURI
- 503 parseCompactURI = parseOnly' compact
- 504 - 505 renderCompactURI :: CompactURI -> ByteString
- 506 renderCompactURI (CompactURI (Prefix p) (RelNoAuth hier mq mf)) = B.concat
- 507 [ p
- 508 , ":"
- 509 , case hier of
+ 504 compactURI :: ByteString -> URI Gen -> URI Gen -> Maybe CompactURI
+ 505 compactURI p b u =
+ 506 CompactURI <$> parseOnly' prefix p <*> splitURI b u
+ 507 + 508 parseRelNoAuth :: ByteString -> Maybe RelNoAuth
+ 509 parseRelNoAuth = parseOnly' relativeNoAuth
+ 510 + 511 relNoAuthFromRelative :: URI Rel -> Maybe RelNoAuth
+ 512 relNoAuthFromRelative (URI _ h q f) =
+ 513 case h of
+ 514 HierarchyAuthorized _ _ -> Nothing
+ 515 HierarchyOther h' -> Just $ RelNoAuth h' q f
+ 516 + 517 relativeFromNoAuth :: RelNoAuth -> URI Rel
+ 518 relativeFromNoAuth (RelNoAuth h q f) =
+ 519 URI (Scheme B.empty) (HierarchyOther h) q f
+ 520 + 521 renderRelNoAuth :: RelNoAuth -> ByteString
+ 522 renderRelNoAuth (RelNoAuth hier mq mf) = B.concat
+ 523 [ case hier of
… … … … - 538 expandCompactURI :: URI Gen -> CompactURI -> Maybe (URI Gen)
- 539 expandCompactURI (URI bs bh bq bf) (CompactURI _ (RelNoAuth rh rq rf)) =
+ 552 parseCompactURI :: ByteString -> Maybe CompactURI
+ 553 parseCompactURI = parseOnly' compact
+ 554 + 555 renderCompactURI :: CompactURI -> ByteString
+ 556 renderCompactURI (CompactURI (Prefix p) rel) =
+ 557 p <> ":" <> renderRelNoAuth rel
+ 558 + 559 uriConcat :: URI Gen -> RelNoAuth -> Maybe (URI Gen)
+ 560 uriConcat (URI bs bh bq bf) (RelNoAuth rh rq rf) =
… … … … + 643 -- TODO RDFa core says use pathRootless i.e. ALLOW literal colon in relative's
+ 644 -- head! Update my code for that, hopefully it makes it simpler!
+ 645 --
+ 646 -- On the other hand, it also means that a compact suffix now can look like an
+ 647 -- absolute URI; but is that a problem? Hmm I hope not; let's just go with the
+ 648 -- stuff RDFa core spec says, and see how it goes.
+ 649 --
+ 650 -- NOTE: Right now, since colons aren't allowed, every RelNoAuth is also a
+ 651 -- valid URI Rel. If I make colons valid, it won't be so anymore. Since
+ 652 -- RelNoAuth is used for CURIE expansion / uriConcat and URI Rel is used for
+ 653 -- relative URI resolution, I'll need to allow for a type that supports both,
+ 654 -- i.e. like AbsoluteOrCompact except it will be RelOrRNA or something like
+ 655 -- that.
+ 656 + 657 expandCompactURI :: URI Gen -> CompactURI -> Maybe (URI Gen)
+ 658 expandCompactURI base (CompactURI _ rel) = uriConcat base rel
+ 659 … … … …