Record for parser/printer components

src/Data/URI/AbsoluteURI.purs

@@ -1,6 +1,8 @@
 module Data.URI.AbsoluteURI
   ( AbsoluteURI(..)
+  , AbsoluteURIParseOptions
   , parser
+  , AbsoluteURIPrintOptions
   , print
   , _scheme
   , _hierPart
@@ -27,58 +29,68 @@ import Text.Parsing.StringParser.Combinators (optionMaybe)
 import Text.Parsing.StringParser.String (eof)
 
 -- | An absolute AbsoluteURI.
-data AbsoluteURI userInfo path query = AbsoluteURI Scheme (HierarchicalPart userInfo path) (Maybe query)
+data AbsoluteURI userInfo hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hierPath) (Maybe query)
 
-derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq path, Eq query) ⇒ Eq (AbsoluteURI userInfo path query)
-derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord path, Ord query) ⇒ Ord (AbsoluteURI userInfo path query)
-derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo path query) _
-instance showAbsoluteURI ∷ (Show userInfo, Show path, Show query) ⇒ Show (AbsoluteURI userInfo path query) where show = genericShow
+derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hierPath query)
+derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hierPath query)
+derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hierPath query) _
+instance showAbsoluteURI ∷ (Show userInfo, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hierPath query) where show = genericShow
+
+type AbsoluteURIParseOptions userInfo hierPath query r =
+  ( parseUserInfo ∷ Parser userInfo
+  , parseHierPath ∷ Parser hierPath
+  , parseQuery ∷ Parser query
+  | r
+  )
 
 parser
-  ∷ ∀ userInfo path query
-  . Parser userInfo
-  → Parser path
-  → Parser query
-  → Parser (AbsoluteURI userInfo path query)
-parser parseUserInfo parsePath parseQuery = AbsoluteURI
+  ∷ ∀ userInfo hierPath query r
+  . Record (AbsoluteURIParseOptions userInfo hierPath query r)
+  → Parser (AbsoluteURI userInfo hierPath query)
+parser opts = AbsoluteURI
   <$> Scheme.parser
-  <*> HPart.parser parseUserInfo parsePath
-  <*> optionMaybe (Query.parser parseQuery)
+  <*> HPart.parser opts
+  <*> optionMaybe (Query.parser opts.parseQuery)
   <* eof
 
+type AbsoluteURIPrintOptions userInfo hierPath query r =
+  ( printUserInfo ∷ userInfo → String
+  , printHierPath ∷ hierPath → String
+  , printQuery ∷ query → String
+  | r
+  )
+
 print
-  ∷ ∀ userInfo path query
-  . (userInfo → String)
-  → (path → String)
-  → (query → String)
-  → AbsoluteURI userInfo path query
+  ∷ ∀ userInfo hierPath query r
+  . Record (AbsoluteURIPrintOptions userInfo hierPath query r)
+  → AbsoluteURI userInfo hierPath query
   → String
-print printUserInfo printPath printQuery (AbsoluteURI s h q) =
+print opts (AbsoluteURI s h q) =
   S.joinWith "" $ catMaybes
     [ Just (Scheme.print s)
-    , Just (HPart.print printUserInfo printPath h)
-    , Query.print printQuery <$> q
+    , Just (HPart.print opts h)
+    , Query.print opts.printQuery <$> q
     ]
 
 _scheme
-  ∷ ∀ userInfo path query
-  . Lens' (AbsoluteURI userInfo path query) Scheme
+  ∷ ∀ userInfo hierPath query
+  . Lens' (AbsoluteURI userInfo hierPath query) Scheme
 _scheme =
   lens
     (\(AbsoluteURI s _ _) → s)
     (\(AbsoluteURI _ h q) s → AbsoluteURI s h q)
 
 _hierPart
-  ∷ ∀ userInfo path query
-  . Lens' (AbsoluteURI userInfo path query) (HierarchicalPart userInfo path)
+  ∷ ∀ userInfo hierPath query
+  . Lens' (AbsoluteURI userInfo hierPath query) (HierarchicalPart userInfo hierPath)
 _hierPart =
   lens
     (\(AbsoluteURI _ h _) → h)
     (\(AbsoluteURI s _ q) h → AbsoluteURI s h q)
 
 _query
-  ∷ ∀ userInfo path query
-  . Lens' (AbsoluteURI userInfo path query) (Maybe query)
+  ∷ ∀ userInfo hierPath query
+  . Lens' (AbsoluteURI userInfo hierPath query) (Maybe query)
 _query =
   lens
     (\(AbsoluteURI _ _ q) → q)

src/Data/URI/Authority.purs

@@ -35,20 +35,27 @@ derive instance ordAuthority ∷ Ord userInfo ⇒ Ord (Authority userInfo)
 derive instance genericAuthority ∷ Generic (Authority userInfo) _
 instance showAuthority ∷ Show userInfo ⇒ Show (Authority userInfo) where show = genericShow
 
-parser ∷ ∀ userInfo. Parser userInfo → Parser (Authority userInfo)
-parser parseUserInfo = do
+parser
+  ∷ ∀ userInfo r
+  . { parseUserInfo ∷ Parser userInfo | r }
+  → Parser (Authority userInfo)
+parser opts = do
   _ ← string "//"
-  ui ← optionMaybe $ try (UserInfo.parser parseUserInfo <* string "@")
+  ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* string "@")
   hosts ← flip sepBy (string ",") $
     Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser)
   pure $ Authority ui (fromFoldable hosts)
 
-print ∷ ∀ userInfo. (userInfo → String) → Authority userInfo → String
-print printUserInfo (Authority ui hs) =
-  "//" <> printUserInfo' ui <> S.joinWith "," (printHostAndPort <$> hs)
+print
+  ∷ ∀ userInfo r
+  . { printUserInfo ∷ userInfo → String | r }
+  → Authority userInfo
+  → String
+print opts (Authority ui hs) =
+  "//" <> printUserInfo ui <> S.joinWith "," (printHostAndPort <$> hs)
   where
-  printUserInfo' =
-    maybe "" (\u → printUserInfo u <> "@")
+  printUserInfo =
+    maybe "" (\u → opts.printUserInfo u <> "@")
   printHostAndPort (Tuple h p) =
     Host.print h <> maybe "" (\n → ":" <> Port.print n) p
 

src/Data/URI/HierarchicalPart.purs

@@ -22,43 +22,55 @@ import Data.URI.Path as Path
 import Text.Parsing.StringParser (Parser)
 
 -- | The "hierarchical part" of a generic or absolute URI.
-data HierarchicalPart userInfo path = HierarchicalPart (Maybe (Authority userInfo)) (Maybe path)
+data HierarchicalPart userInfo hierPath = HierarchicalPart (Maybe (Authority userInfo)) (Maybe hierPath)
 
-derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq path) ⇒ Eq (HierarchicalPart userInfo path)
-derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord path) ⇒ Ord (HierarchicalPart userInfo path)
-derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo path) _
-instance showHierarchicalPart ∷ (Show userInfo, Show path) ⇒ Show (HierarchicalPart userInfo path) where show = genericShow
+derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hierPath)
+derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hierPath)
+derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hierPath) _
+instance showHierarchicalPart ∷ (Show userInfo, Show hierPath) ⇒ Show (HierarchicalPart userInfo hierPath) where show = genericShow
 
-parser ∷ ∀ userInfo path. Parser userInfo → Parser path → Parser (HierarchicalPart userInfo path)
-parser parseUserInfo parsePath = withAuth <|> withoutAuth
+parser
+  ∷ ∀ userInfo hierPath r
+  . { parseUserInfo ∷ Parser userInfo
+    , parseHierPath ∷ Parser hierPath
+    | r
+    }
+  → Parser (HierarchicalPart userInfo hierPath)
+parser opts = withAuth <|> withoutAuth
   where
   withAuth =
     HierarchicalPart <<< Just
-      <$> Authority.parser parseUserInfo
-      <*> Path.parsePathAbEmpty parsePath
+      <$> Authority.parser opts
+      <*> Path.parsePathAbEmpty opts.parseHierPath
 
   withoutAuth = HierarchicalPart Nothing <$> noAuthPath
 
   noAuthPath
-      = (Just <$> Path.parsePathAbsolute parsePath)
-    <|> (Just <$> Path.parsePathRootless parsePath)
+      = (Just <$> Path.parsePathAbsolute opts.parseHierPath)
+    <|> (Just <$> Path.parsePathRootless opts.parseHierPath)
     <|> pure Nothing
 
-print ∷ ∀ userInfo path. (userInfo → String) → (path → String) → HierarchicalPart userInfo path → String
-print printUserInfo printPath (HierarchicalPart a p) =
+print
+  ∷ ∀ userInfo hierPath r
+  . { printUserInfo ∷ userInfo → String
+    , printHierPath ∷ hierPath → String
+    | r
+    }
+  → HierarchicalPart userInfo hierPath → String
+print opts (HierarchicalPart a p) =
   S.joinWith "" $
     catMaybes
-      [ Authority.print printUserInfo <$> a
-      , printPath <$> p
+      [ Authority.print opts <$> a
+      , opts.printHierPath <$> p
       ]
 
-_authority ∷ ∀ userInfo path. Lens' (HierarchicalPart userInfo path) (Maybe (Authority userInfo))
+_authority ∷ ∀ userInfo hierPath. Lens' (HierarchicalPart userInfo hierPath) (Maybe (Authority userInfo))
 _authority =
   lens
     (\(HierarchicalPart a _) → a)
     (\(HierarchicalPart _ p) a → HierarchicalPart a p)
 
-_path ∷ ∀ userInfo path. Lens' (HierarchicalPart userInfo path) (Maybe path)
+_path ∷ ∀ userInfo hierPath. Lens' (HierarchicalPart userInfo hierPath) (Maybe hierPath)
 _path =
   lens
     (\(HierarchicalPart _ p) → p)

src/Data/URI/RelativePart.purs

@@ -22,44 +22,56 @@ import Data.URI.Path as Path
 import Text.Parsing.StringParser (Parser)
 
 -- | The "relative part" of a relative reference.
-data RelativePart userInfo path = RelativePart (Maybe (Authority userInfo)) (Maybe path)
+data RelativePart userInfo relPath = RelativePart (Maybe (Authority userInfo)) (Maybe relPath)
 
-derive instance eqRelativePart ∷ (Eq userInfo, Eq path) ⇒ Eq (RelativePart userInfo path)
-derive instance ordRelativePart ∷ (Ord userInfo, Ord path) ⇒ Ord (RelativePart userInfo path)
-derive instance genericRelativePart ∷ Generic (RelativePart userInfo path) _
-instance showRelativePart ∷ (Show userInfo, Show path) ⇒ Show (RelativePart userInfo path) where show = genericShow
+derive instance eqRelativePart ∷ (Eq userInfo, Eq relPath) ⇒ Eq (RelativePart userInfo relPath)
+derive instance ordRelativePart ∷ (Ord userInfo, Ord relPath) ⇒ Ord (RelativePart userInfo relPath)
+derive instance genericRelativePart ∷ Generic (RelativePart userInfo relPath) _
+instance showRelativePart ∷ (Show userInfo, Show relPath) ⇒ Show (RelativePart userInfo relPath) where show = genericShow
 
-parser ∷ ∀ userInfo path. Parser userInfo → Parser path → Parser (RelativePart userInfo path)
-parser parseUserInfo parsePath = withAuth <|> withoutAuth
+parser
+  ∷ ∀ userInfo relPath r
+  . { parseUserInfo ∷ Parser userInfo
+    , parseRelPath ∷ Parser relPath
+    | r
+    }
+  → Parser (RelativePart userInfo relPath)
+parser opts = withAuth <|> withoutAuth
   where
 
   withAuth =
     RelativePart
-      <$> Just <$> Authority.parser parseUserInfo
-      <*> Path.parsePathAbEmpty parsePath
+      <$> Just <$> Authority.parser opts
+      <*> Path.parsePathAbEmpty opts.parseRelPath
 
   withoutAuth = RelativePart Nothing <$> noAuthPath
 
   noAuthPath
-      = (Just <$> Path.parsePathAbsolute parsePath)
-    <|> (Just <$> Path.parsePathNoScheme parsePath)
+      = (Just <$> Path.parsePathAbsolute opts.parseRelPath)
+    <|> (Just <$> Path.parsePathNoScheme opts.parseRelPath)
     <|> pure Nothing
 
-print ∷ ∀ userInfo path. (userInfo → String) → (path → String) → RelativePart userInfo path → String
-print printUserInfo printPath (RelativePart a p) =
+print
+  ∷ ∀ userInfo relPath r
+  . { printUserInfo ∷ userInfo → String
+    , printRelPath ∷ relPath → String
+    | r
+    }
+  → RelativePart userInfo relPath → String
+print opts (RelativePart a p) =
   S.joinWith "" $
     catMaybes
-      [ Authority.print printUserInfo <$> a
-      , printPath <$> p
+      [ Authority.print opts <$> a
+      , opts.printRelPath <$> p
       ]
 
-_authority ∷ ∀ userInfo path. Lens' (RelativePart userInfo path) (Maybe (Authority userInfo))
+_authority ∷ ∀ userInfo relPath. Lens' (RelativePart userInfo relPath) (Maybe (Authority userInfo))
 _authority =
   lens
     (\(RelativePart a _) → a)
     (\(RelativePart _ p) a → RelativePart a p)
 
-_path ∷ ∀ userInfo path. Lens' (RelativePart userInfo path) (Maybe path)
+_path ∷ ∀ userInfo relPath. Lens' (RelativePart userInfo relPath) (Maybe relPath)
 _path =
   lens
     (\(RelativePart _ p) → p)

src/Data/URI/RelativeRef.purs

@@ -25,64 +25,65 @@ import Text.Parsing.StringParser.Combinators (optionMaybe)
 import Text.Parsing.StringParser.String (eof)
 
 -- | A relative reference for a URI.
-data RelativeRef userInfo path query fragment = RelativeRef (RelativePart userInfo path) (Maybe query) (Maybe fragment)
+data RelativeRef userInfo relPath query fragment = RelativeRef (RelativePart userInfo relPath) (Maybe query) (Maybe fragment)
 
-derive instance eqRelativeRef ∷ (Eq userInfo, Eq path, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo path query fragment)
-derive instance ordRelativeRef ∷ (Ord userInfo, Ord path, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo path query fragment)
-derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo path query fragment) _
-instance showRelativeRef ∷ (Show userInfo, Show path, Show query, Show fragment) ⇒ Show (RelativeRef userInfo path query fragment) where show = genericShow
---
--- parse ∷ String → Either ParseError RelativeRef
--- parse = runParser parser
+derive instance eqRelativeRef ∷ (Eq userInfo, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo relPath query fragment)
+derive instance ordRelativeRef ∷ (Ord userInfo, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo relPath query fragment)
+derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo relPath query fragment) _
+instance showRelativeRef ∷ (Show userInfo, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo relPath query fragment) where show = genericShow
 
 parser
-  ∷ ∀ userInfo path query fragment
-  . Parser userInfo
-  → Parser path
-  → Parser query
-  → Parser fragment
-  → Parser (RelativeRef userInfo path query fragment)
-parser parseUserInfo parsePath parseQuery parseFragment =
+  ∷ ∀ userInfo relPath query fragment r
+  . { parseUserInfo ∷ Parser userInfo
+    , parseRelPath ∷ Parser relPath
+    , parseQuery ∷ Parser query
+    , parseFragment ∷ Parser fragment
+    | r
+    }
+  → Parser (RelativeRef userInfo relPath query fragment)
+parser opts =
   RelativeRef
-    <$> RPart.parser parseUserInfo parsePath
-    <*> optionMaybe (Query.parser parseQuery)
-    <*> optionMaybe (Fragment.parser parseFragment)
+    <$> RPart.parser opts
+    <*> optionMaybe (Query.parser opts.parseQuery)
+    <*> optionMaybe (Fragment.parser opts.parseFragment)
     <* eof
 
 print
-  ∷ ∀ userInfo path query fragment
-  . (userInfo → String)
-  → (path → String)
-  → (query → String)
-  → (fragment → String)
-  → RelativeRef userInfo path query fragment
+  ∷ ∀ userInfo relPath query fragment r
+  . { printUserInfo ∷ userInfo → String
+    , printRelPath ∷ relPath → String
+    , printQuery ∷ query → String
+    , printFragment ∷ fragment → String
+    | r
+    }
+  → RelativeRef userInfo relPath query fragment
   → String
-print printUserInfo printPath printQuery printFragment (RelativeRef h q f) =
+print opts (RelativeRef h q f) =
   S.joinWith "" $ catMaybes
-    [ Just (RPart.print printUserInfo printPath h)
-    , Query.print printQuery <$> q
-    , Fragment.print printFragment <$> f
+    [ Just (RPart.print opts h)
+    , Query.print opts.printQuery <$> q
+    , Fragment.print opts.printFragment <$> f
     ]
 
 _relPart
-  ∷ ∀ userInfo path query fragment
-  . Lens' (RelativeRef userInfo path query fragment) (RelativePart userInfo path)
+  ∷ ∀ userInfo relPath query fragment
+  . Lens' (RelativeRef userInfo relPath query fragment) (RelativePart userInfo relPath)
 _relPart =
   lens
     (\(RelativeRef r _ _) → r)
     (\(RelativeRef _ q f) r → RelativeRef r q f)
 
 _query
-  ∷ ∀ userInfo path query fragment
-  . Lens' (RelativeRef userInfo path query fragment) (Maybe query)
+  ∷ ∀ userInfo relPath query fragment
+  . Lens' (RelativeRef userInfo relPath query fragment) (Maybe query)
 _query =
   lens
     (\(RelativeRef _ q _) → q)
     (\(RelativeRef r _ f) q → RelativeRef r q f)
 
 _fragment
-  ∷ ∀ userInfo path query fragment
-  . Lens' (RelativeRef userInfo path query fragment) (Maybe fragment)
+  ∷ ∀ userInfo relPath query fragment
+  . Lens' (RelativeRef userInfo relPath query fragment) (Maybe fragment)
 _fragment =
   lens
     (\(RelativeRef _ _ f) → f)