Merge pull request #30 from garyb/lenses

Add lenses

Author: garyb

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",

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)

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)

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)

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

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)

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)

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)