From 9942cf662598636797837b4730edce67058a2e2c Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 3 Oct 2017 20:56:06 +0100 Subject: [PATCH] Add lenses --- bower.json | 3 ++- src/Data/URI/AbsoluteURI.purs | 21 ++++++++++++++++++++- src/Data/URI/Authority.purs | 17 +++++++++++++++-- src/Data/URI/HierarchicalPart.purs | 15 ++++++++++++++- src/Data/URI/Host.purs | 16 ++++++++++++++++ src/Data/URI/RelativePart.purs | 15 ++++++++++++++- src/Data/URI/RelativeRef.purs | 21 ++++++++++++++++++++- src/Data/URI/URI.purs | 27 ++++++++++++++++++++++++++- 8 files changed, 127 insertions(+), 8 deletions(-) diff --git a/bower.json b/bower.json index 4ee6329..5fe2447 100755 --- a/bower.json +++ b/bower.json @@ -23,7 +23,8 @@ "purescript-pathy": "^4.0.0", "purescript-string-parsers": "^3.0.0", "purescript-unfoldable": "^3.0.0", - "purescript-generics-rep": "^5.2.0" + "purescript-generics-rep": "^5.2.0", + "purescript-profunctor-lenses": "^3.7.0" }, "devDependencies": { "purescript-test-unit": "11.0.0", diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index c2446b6..2ea7497 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -4,9 +4,10 @@ import Prelude import Data.Array (catMaybes) import Data.Either (Either) +import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI (AbsoluteURI(..)) +import Data.URI (AbsoluteURI(..), HierarchicalPart, Query, Scheme) import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme as Scheme @@ -31,3 +32,21 @@ print (AbsoluteURI s h q) = , Just (HPart.print h) , Query.print <$> q ] + +_scheme ∷ Lens' AbsoluteURI (Maybe Scheme) +_scheme = + lens + (\(AbsoluteURI s _ _) → s) + (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) + +_hierPart ∷ Lens' AbsoluteURI HierarchicalPart +_hierPart = + lens + (\(AbsoluteURI _ h _) → h) + (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) + +_query ∷ Lens' AbsoluteURI (Maybe Query) +_query = + lens + (\(AbsoluteURI _ _ q) → q) + (\(AbsoluteURI s h _) q → AbsoluteURI s h q) diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index 495af1b..74b5427 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -3,10 +3,11 @@ module Data.URI.Authority where import Prelude import Data.Array (fromFoldable) -import Data.Maybe (maybe) +import Data.Lens (Lens', lens) +import Data.Maybe (Maybe, maybe) import Data.String as S import Data.Tuple (Tuple(..)) -import Data.URI (Authority(..)) +import Data.URI (Authority(..), Host, Port, UserInfo) import Data.URI.Host as Host import Data.URI.Port as Port import Data.URI.UserInfo as UserInfo @@ -29,3 +30,15 @@ print (Authority ui hs) = maybe "" (\u → UserInfo.print u <> "@") ui printHostAndPort (Tuple h p) = Host.print h <> maybe "" (\n → ":" <> Port.print n) p + +_userInfo ∷ Lens' Authority (Maybe UserInfo) +_userInfo = + lens + (\(Authority ui _) → ui) + (\(Authority _ hs) ui → Authority ui hs) + +_hosts ∷ Lens' Authority (Array (Tuple Host (Maybe Port))) +_hosts = + lens + (\(Authority _ hs) → hs) + (\(Authority ui _) hs → Authority ui hs) diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 86746e2..b20e866 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -4,9 +4,10 @@ import Prelude import Control.Alt ((<|>)) import Data.Array (catMaybes) +import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI (HierarchicalPart(..)) +import Data.URI (Authority, HierarchicalPart(..), URIPathAbs) import Data.URI.Authority as Authority import Data.URI.Path (printPath, parseURIPathAbs, parsePathRootless, parsePathAbsolute, parsePathAbEmpty) import Text.Parsing.StringParser (Parser) @@ -29,3 +30,15 @@ parser = withAuth <|> withoutAuth print ∷ HierarchicalPart → String print (HierarchicalPart a p) = S.joinWith "" (catMaybes [Authority.print <$> a, printPath <$> p]) + +_authority ∷ Lens' HierarchicalPart (Maybe Authority) +_authority = + lens + (\(HierarchicalPart a _) → a) + (\(HierarchicalPart _ p) a → HierarchicalPart a p) + +_path ∷ Lens' HierarchicalPart (Maybe URIPathAbs) +_path = + lens + (\(HierarchicalPart _ p) → p) + (\(HierarchicalPart a _) p → HierarchicalPart a p) diff --git a/src/Data/URI/Host.purs b/src/Data/URI/Host.purs index 3d4ff2c..8e2e3a4 100644 --- a/src/Data/URI/Host.purs +++ b/src/Data/URI/Host.purs @@ -4,6 +4,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Int as Int +import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) import Data.URI (Host(..)) import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved, rxPat) @@ -48,3 +49,18 @@ print ∷ Host → String print (IPv6Address i) = "[" <> i <> "]" print (IPv4Address i) = i print (NameAddress i) = encodeURI i + +_IPv6Address ∷ Prism' Host String +_IPv6Address = prism' IPv6Address case _ of + IPv6Address s → Just s + _ → Nothing + +_IPv4Address ∷ Prism' Host String +_IPv4Address = prism' IPv4Address case _ of + IPv4Address s → Just s + _ → Nothing + +_NameAddress ∷ Prism' Host String +_NameAddress = prism' NameAddress case _ of + NameAddress s → Just s + _ → Nothing diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 530f5bc..b222134 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -4,9 +4,10 @@ import Prelude import Control.Alt ((<|>)) import Data.Array (catMaybes) +import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI (RelativePart(..)) +import Data.URI (Authority, RelativePart(..), URIPathRel) import Data.URI.Authority as Authority import Data.URI.Path (printPath, parseURIPathRel, parsePathNoScheme, parsePathAbsolute, parsePathAbEmpty) import Text.Parsing.StringParser (Parser) @@ -35,3 +36,15 @@ print (RelativePart a p) = [ (\auth → "//" <> Authority.print auth) <$> a , printPath <$> p ] + +_authority ∷ Lens' RelativePart (Maybe Authority) +_authority = + lens + (\(RelativePart a _) → a) + (\(RelativePart _ p) a → RelativePart a p) + +_path ∷ Lens' RelativePart (Maybe URIPathRel) +_path = + lens + (\(RelativePart _ p) → p) + (\(RelativePart a _) p → RelativePart a p) diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 97cdd46..f40bd6f 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -4,9 +4,10 @@ import Prelude import Data.Array (catMaybes) import Data.Either (Either) +import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI (RelativeRef(..)) +import Data.URI (Fragment, Query, RelativePart, RelativeRef(..)) import Data.URI.Fragment as Fragment import Data.URI.Query as Query import Data.URI.RelativePart as RPart @@ -31,3 +32,21 @@ print (RelativeRef h q f) = , Query.print <$> q , (\frag → "#" <> Fragment.print frag) <$> f ] + +_relPart ∷ Lens' RelativeRef RelativePart +_relPart = + lens + (\(RelativeRef r _ _) → r) + (\(RelativeRef _ q f) r → RelativeRef r q f) + +_query ∷ Lens' RelativeRef (Maybe Query) +_query = + lens + (\(RelativeRef _ q _) → q) + (\(RelativeRef r _ f) q → RelativeRef r q f) + +_fragment ∷ Lens' RelativeRef (Maybe Fragment) +_fragment = + lens + (\(RelativeRef _ _ f) → f) + (\(RelativeRef r q _) f → RelativeRef r q f) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 1f3c615..833ae3f 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -4,9 +4,10 @@ import Prelude import Data.Array (catMaybes) import Data.Either (Either) +import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI (URI(..)) +import Data.URI (Fragment, HierarchicalPart, Query, Scheme, URI(..)) import Data.URI.Fragment as Fragment import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query @@ -34,3 +35,27 @@ print (URI s h q f) = , Query.print <$> q , (\frag → "#" <> Fragment.print frag) <$> f ] + +_scheme ∷ Lens' URI (Maybe Scheme) +_scheme = + lens + (\(URI s _ _ _) → s) + (\(URI _ h q f) s → URI s h q f) + +_hierPart ∷ Lens' URI HierarchicalPart +_hierPart = + lens + (\(URI _ h _ _) → h) + (\(URI s _ q f) h → URI s h q f) + +_query ∷ Lens' URI (Maybe Query) +_query = + lens + (\(URI _ _ q _) → q) + (\(URI s h _ f) q → URI s h q f) + +_fragment ∷ Lens' URI (Maybe Fragment) +_fragment = + lens + (\(URI _ _ _ f) → f) + (\(URI s h q _) f → URI s h q f)