uri-templater 0.3.0.0 → 0.3.1.0

raw patch · 5 files changed

+484/−44 lines, 5 filesdep +timedep +uuid-typesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: time, uuid-types

API changes (from Hackage documentation)

Files

• src/Network/URI/Template.hs +222/−3
• src/Network/URI/Template/Internal.hs +25/−22
• src/Network/URI/Template/TH.hs +1/−0
• src/Network/URI/Template/Types.hs +232/−17
• uri-templater.cabal +4/−2

@@ -1,18 +1,237 @@+{- |+  RFC 6570 URI templates are a convenient mechanism for constructing URIs in+  a standardized way. They provide the ability to escape the interpolated values appropriately,+  format them for the appropriate part of the URI, and can handle list-like (@[]@, @Vector@)+  and associative inputs (such as associative lists, @Map@s, @HashMap@s).++  This implementation supports outputting these URI fragments to all widely-used textual/bytestring+  formats, and provides basic facilities for extending the URI rendering to support other output formats.+-}+ module Network.URI.Template (+  -- $overview++  -- * Quasi-Quoting URI templates     uri+  -- * Manually parsing, constructing, & writing URI templates   , render+  , ToTemplateValue(..)+  , AList(..)+  , TemplateString(..)   , parseTemplate   , UriTemplate(..)   , TemplateSegment(..)   , Modifier(..)   , ValueModifier(..)   , TemplateValue(..)-  , ToTemplateValue(..)-  , AList(..)-  , TemplateString(..)+  -- * Implementing a new output format for URI templates   , Buildable(..) ) where import Network.URI.Template.Internal import Network.URI.Template.Parser import Network.URI.Template.TH import Network.URI.Template.Types++{- $overview++Due to the large number of different interpolation options available, it is arguably easiest+to view an example of each sort of interpolation to see how it works.+RFC 6570 itself <https://tools.ietf.org/html/rfc6570> also+provides a large number of these same examples, so it may help to look at it directly.++For these examples, the following values are assumed:++@+var :: TemplateString+var = "value"++semi :: TemplateString+semi = ";"++hello :: TemplateString+hello = "Hello World!"++path :: TemplateString+path = "\/foo\/bar"++list :: [TemplateString]+list = ["red", "green", "blue"]++keys :: AList TemplateString TemplateString+keys = AList [("semi", ";"), ("dot", "."), ("comma", ",")]+@++= Simple interpolation++Simple string expansion is the default expression type when no+operator is given.++For each defined variable in the variable-list, perform variable+expansion. If more than one variable has a+defined value, append a comma (",") to the result string as a+separator between variable expansions.++== Without modifiers++>>> [uri|{var}|]+value++== Interpolating with a length modifier++>>> [uri|{var:3}|]+val++== Interpolating multiple values:++>>> [uri|{var,hello}|]+value,hello++== Interpolating a list:++>>> [uri|{list}|]+red,green,blue++== Exploding a list (not super useful without modifiers):++>>> [uri|{list*}|]+red,green,blue++== Interpolating associative values:++>>> [uri|{keys}|]+semi,%3B,dot,.,comma,%2C++== Exploding associative values++>>> [uri|{keys*}|]+semi=%3B,dot=.,comma=%2C++= Unescaped interpolation++>>> [uri|{+path:6}/here|]+/foo/b/here++>>> [uri|{+list}|]+red,green,blue++>>> [uri|{+list*}|]+red,green,blue++>>> [uri|{+keys}]+semi,;,dot,.,comma,,++>>> [uri|{+keys*}]+semi=;,dot=.,comma=,++= Path piece interpolation++Path segment expansion, as indicated by the slash ("/"), is useful for describing URI path+hierarchies.++For each defined variable in the variable-list, append "/" to the+result string and then perform variable expansion.++Note that the expansion process for path segment expansion is+identical to that of label expansion aside from the substitution of+"/" instead of ".".  However, unlike ".", a "/" is a reserved+character and will be percent-encoded if found in a value.++>>> [uri|{/var:1,var}|]+/v/value++>>> [uri|{/list}|]+/red,green,blue++>>> [uri|{/list*}]+/red/green/blue++= Query param interpolation++>>> [uri|{?var:3}|]+?var=val++>>> [uri|{?list}|]+?list=red,green.blue++>>> [uri|{?list*}|]+?list=red&list=green&list=blue++>>> [uri|{?keys}|]+?keys=semi,%3B,dot,.,comma,%2C++>>> [uri|{?keys*}|]+?semi=%3B&dot=.&comma=%2C++= Continued query param interpolation++>>> [uri|{?var:3}|]+&var=val++>>> [uri|{?list}|]+&list=red,green.blue++>>> [uri|{?list*}|]+&list=red&list=green&list=blue++>>> [uri|{?keys}|]+&keys=semi,%3B,dot,.,comma,%2C++>>> [uri|{?keys*}|]+&semi=%3B&dot=.&comma=%2C++= Label interpolation++Label expansion, as indicated by the dot (".") operator is useful for describing URI spaces with varying+domain names or path selectors (e.g., filename extensions).++>>> [uri|X{.var:3}|]+X.val++>>> [uri|X{.list}|]+X.red,green,blue++>>> [uri|X{.list*}|]+X.red.green.blue++>>> [uri|X{.keys}|]+X.semi,%3B,dot,.,comma,%2C++>>> [uri|X{.keys*}|]+X.semi=%3B.dot=..comma=%2C++= Fragment interpolation++Path-style parameter expansion, as indicated by the semicolon (";")+is useful for describing URI path parameters, such as "path;property" or "path;name=value".++>>> [uri|{;hello:5}|]+;hello=Hello+++>>> [uri|{;list}|]+;list=red,green,blue+++>>> [uri|{;list*}|]+;list=red;list=green;list=blue+++>>> [uri|{;keys}|]+;keys=semi,%3B,dot,.,comma,%2C+++>>> [uri|{;keys*}|]+;semi=%3B;dot=.;comma=%2C++= Security Considerations++A URI Template does not contain active or executable content.+However, it might be possible to craft unanticipated URIs if an+attacker is given control over the template or over the variable+values within an expression that allows reserved characters in the+expansion.  In either case, the security considerations are largely+determined by who provides the template, who provides the values to+use for variables within the template, in what execution context the+expansion occurs (client or server), and where the resulting URIs are+used.+-}

@@ -23,50 +23,53 @@ import Network.HTTP.Base (urlEncode) import Network.URI.Template.Types -class Monoid (StringBuilder a) => Buildable a where-  type StringBuilder a-  build :: StringBuilder a -> a-  addChar :: Proxy a -> Char -> StringBuilder a-  addString :: Proxy a -> String -> StringBuilder a+class Monoid (Builder a) => Buildable a where+  type Builder a+  -- | Convert the intermediate output into the end result+  build :: Builder a -> a+  -- | Construct an appendable character representation+  addChar :: Proxy a -> Char -> Builder a+  -- | Construct an appendable string representation+  addString :: Proxy a -> String -> Builder a  instance Buildable String where-  type StringBuilder String = DList Char+  type Builder String = DList Char   build = Data.DList.toList   addChar _ = singleton   addString _ = fromList  instance Buildable BS.ByteString where-  type StringBuilder BS.ByteString = BB.Builder+  type Builder BS.ByteString = BB.Builder   build = BL.toStrict . BB.toLazyByteString   addChar _ = BB.char8   addString _ = BB.string8  instance Buildable BL.ByteString where-  type StringBuilder BL.ByteString = BB.Builder+  type Builder BL.ByteString = BB.Builder   build = BB.toLazyByteString   addChar _ = BB.char8   addString _ = BB.string8  instance Buildable T.Text where-  type StringBuilder T.Text = TB.Builder+  type Builder T.Text = TB.Builder   build = TL.toStrict . TB.toLazyText   addChar _ = TB.singleton   addString _ = TB.fromString  instance Buildable TL.Text where-  type StringBuilder TL.Text = TB.Builder+  type Builder TL.Text = TB.Builder   build = TB.toLazyText   addChar _ = TB.singleton   addString _ = TB.fromString  instance Buildable BB.Builder where-  type StringBuilder BB.Builder = BB.Builder+  type Builder BB.Builder = BB.Builder   build = id   addChar _ = BB.char8   addString _ = BB.string8  instance Buildable TB.Builder where-  type StringBuilder TB.Builder = TB.Builder+  type Builder TB.Builder = TB.Builder   build = id   addChar _ = TB.singleton   addString _ = TB.fromString@@ -109,7 +112,7 @@  namePrefix :: forall str a.               (Buildable str)-           => Proxy str -> ProcessingOptions -> String -> TemplateValue a -> StringBuilder str+           => Proxy str -> ProcessingOptions -> String -> TemplateValue a -> Builder str namePrefix p opts name val = addString p name <> if templateValueIsEmpty val   then maybe mempty (addChar p) $ modifierIfEmpty opts   else addChar p '='@@ -120,7 +123,7 @@ processVariable   :: forall str.      (Buildable str)-  => Proxy str -> Modifier -> Bool -> Variable -> WrappedValue -> StringBuilder str+  => Proxy str -> Modifier -> Bool -> Variable -> WrappedValue -> Builder str processVariable p m isFirst (Variable varName varMod) (WrappedValue val) =   let prefix = maybe mempty (addChar p) $ modifierPrefix settings       separator = addChar p $ modifierSeparator settings@@ -138,12 +141,12 @@   where     settings = options m -    addEncodeString :: String -> StringBuilder str+    addEncodeString :: String -> Builder str     addEncodeString = addString p . (allowEncoder $ modifierAllow settings)      sepByCommas = mconcat . intersperse (addChar p ',') -    associativeCommas :: (String -> String) -> (TemplateValue Single, TemplateValue Single) -> StringBuilder str+    associativeCommas :: (String -> String) -> (TemplateValue Single, TemplateValue Single) -> Builder str     associativeCommas f (Single n, Single v) =       addEncodeString n <>       addChar p ',' <>@@ -159,13 +162,13 @@       (List l) -> sepByCommas $ map (\(Single s) -> addEncodeString $ preprocess s) l       (Single s) -> addEncodeString $ preprocess s -    explodedAssociative :: (TemplateValue Single, TemplateValue Single) -> StringBuilder str+    explodedAssociative :: (TemplateValue Single, TemplateValue Single) -> Builder str     explodedAssociative (Single k, Single v) =       addEncodeString k <>       addChar p '=' <>       addEncodeString (preprocess v) -    exploded :: StringBuilder str+    exploded :: Builder str     exploded = case val of       (Single s) -> whenM                     (modifierSupportsNamed settings)@@ -184,7 +187,7 @@  processVariables :: forall str.                     (Buildable str)-                 => Proxy str -> [(String, WrappedValue)] -> Modifier -> [Variable] -> StringBuilder str+                 => Proxy str -> [(String, WrappedValue)] -> Modifier -> [Variable] -> Builder str processVariables p env m vs = mconcat processedVariables   where     findValue (Variable varName _) = lookup varName env@@ -192,10 +195,10 @@     nonEmptyVariables :: [(Variable, WrappedValue)]     nonEmptyVariables = catMaybes $ map (\v -> fmap (\mv -> (v, mv)) $ findValue v) vs -    processors :: [Variable -> WrappedValue -> StringBuilder str]+    processors :: [Variable -> WrappedValue -> Builder str]     processors = (processVariable p m True) : repeat (processVariable p m False) -    processedVariables :: [StringBuilder str]+    processedVariables :: [Builder str]     processedVariables = zipWith uncurry processors nonEmptyVariables  render :: (Buildable str) => UriTemplate -> [BoundValue] -> str@@ -207,7 +210,7 @@     p :: Proxy str     p = Proxy -    go :: TemplateSegment -> StringBuilder str+    go :: TemplateSegment -> Builder str     go (Literal s) = addString p s     go (Embed m vs) = processVariables p env m vs 

@@ -46,6 +46,7 @@     Left err -> fail $ show err     Right tpl -> templateToExp tpl +-- | URI quasiquoter. Can only be used in expressions, not for top-level declarations uri :: QuasiQuoter uri = QuasiQuoter   { quoteExp = quasiEval

@@ -2,18 +2,28 @@ module Network.URI.Template.Types where import Control.Arrow import Data.Foldable as F+import Data.Functor.Identity import Data.List import qualified Data.String as S import qualified Data.HashMap.Strict as HS+import Data.Int+import Data.Word import qualified Data.Map.Strict as MS+import Data.Monoid+import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Text.Lazy as TL+import Data.Time+import Data.Version+import qualified Data.UUID.Types as UUID import qualified Data.Vector as V+import Numeric.Natural  data Single data Associative data List +-- | All values must reduce to a single value pair, an associative list of keys and values, or a list of values without keys. data TemplateValue a where   Single :: String -> TemplateValue Single   Associative :: [(TemplateValue Single, TemplateValue Single)] -> TemplateValue Associative@@ -29,29 +39,134 @@ data WrappedValue where   WrappedValue :: TemplateValue a -> WrappedValue +-- | A simple wrapper for interpolating Haskell 98 strings into templates. newtype TemplateString = String { fromString :: String }   deriving (Read, Show, Eq, S.IsString) +-- | A simple list of key value pairs. Useful when you want to be able to have multiple duplicate+-- keys, which 'Map' and 'HashMap' don't support. newtype AList k v = AList   { fromAList :: [(k, v)]-  }+  } deriving (Read, Show, Eq)  class ToTemplateValue a where-  type TemplateRep a+  type TemplateRep a :: *+  type TemplateRep a = Single   toTemplateValue :: a -> TemplateValue (TemplateRep a) +instance ToTemplateValue () where+  toTemplateValue = const $ Single "_"++instance ToTemplateValue Bool where+  toTemplateValue = Single . show+ instance ToTemplateValue Int where-  type TemplateRep Int = Single   toTemplateValue = Single . show +instance ToTemplateValue Integer where+  toTemplateValue = Single . show++instance ToTemplateValue Natural where+  toTemplateValue = Single . show++instance ToTemplateValue Double where+  toTemplateValue = Single . show++instance ToTemplateValue Float where+  toTemplateValue = Single . show++instance ToTemplateValue Int8 where+  toTemplateValue = Single . show++instance ToTemplateValue Int16 where+  toTemplateValue = Single . show++instance ToTemplateValue Int32 where+  toTemplateValue = Single . show++instance ToTemplateValue Int64 where+  toTemplateValue = Single . show++instance ToTemplateValue Word where+  toTemplateValue = Single . show++instance ToTemplateValue Word8 where+  toTemplateValue = Single . show++instance ToTemplateValue Word16 where+  toTemplateValue = Single . show++instance ToTemplateValue Word32 where+  toTemplateValue = Single . show++instance ToTemplateValue Word64 where+  toTemplateValue = Single . show+ instance ToTemplateValue TemplateString where-  type TemplateRep TemplateString = Single   toTemplateValue = Single . fromString +instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Dual a) where+  toTemplateValue = toTemplateValue . getDual++instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Sum a) where+  toTemplateValue = toTemplateValue . getSum++instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Product a) where+  toTemplateValue = toTemplateValue . getProduct++instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (First a) where+  toTemplateValue = toTemplateValue . getFirst++instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Last a) where+  toTemplateValue = toTemplateValue . getLast++instance ToTemplateValue All where+  toTemplateValue = toTemplateValue . getAll++instance ToTemplateValue Any where+  toTemplateValue = toTemplateValue . getAny++instance ToTemplateValue UUID.UUID where+  toTemplateValue = Single . UUID.toString++timeToString :: FormatTime t => String -> t -> String+timeToString fmt = formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))++instance ToTemplateValue UTCTime where+  toTemplateValue = Single . timeToString "%H:%M:%S%QZ"++instance ToTemplateValue NominalDiffTime where+  toTemplateValue = toTemplateValue . (floor :: NominalDiffTime -> Integer)++instance ToTemplateValue LocalTime where+  toTemplateValue = Single . timeToString "%H:%M:%S%Q"++instance ToTemplateValue ZonedTime where+  toTemplateValue = Single . timeToString "%H:%M:%S%Q%z"++instance ToTemplateValue TimeOfDay where+  toTemplateValue = Single . formatTime defaultTimeLocale "%H:%M:%S%Q"++instance ToTemplateValue Day where+  toTemplateValue = Single . show++instance ToTemplateValue Version where+  toTemplateValue = Single . showVersion++instance ToTemplateValue Ordering where+  toTemplateValue = Single . show++instance (ToTemplateValue a, ToTemplateValue b, TemplateRep a ~ Single, TemplateRep b ~ Single) => ToTemplateValue (Either a b) where+  toTemplateValue = either toTemplateValue toTemplateValue+ instance (ToTemplateValue a, (TemplateRep a) ~ Single) => ToTemplateValue [a] where   type TemplateRep [a] = List   toTemplateValue = List . map toTemplateValue +instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (NE.NonEmpty a) where+  type TemplateRep (NE.NonEmpty a) = List+  toTemplateValue = toTemplateValue . NE.toList+ instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (AList k v) where   type TemplateRep (AList k v) = Associative   toTemplateValue = Associative . map (toTemplateValue *** toTemplateValue) . fromAList@@ -61,15 +176,12 @@   toTemplateValue = List . F.toList . fmap toTemplateValue  instance ToTemplateValue T.Text where-  type TemplateRep T.Text = Single   toTemplateValue = Single . T.unpack  instance ToTemplateValue TL.Text where-  type TemplateRep TL.Text = Single   toTemplateValue = Single . TL.unpack  instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Maybe a) where-  type TemplateRep (Maybe a) = Single   toTemplateValue = maybe (Single "") toTemplateValue  instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (HS.HashMap k v) where@@ -80,6 +192,106 @@   type TemplateRep (MS.Map k v) = Associative   toTemplateValue = toTemplateValue . AList . MS.toList +instance ToTemplateValue a => ToTemplateValue (Identity a) where+  type TemplateRep (Identity a) = TemplateRep a+  toTemplateValue = toTemplateValue . runIdentity++instance+  ( ToTemplateValue a, TemplateRep a ~ Single+  , ToTemplateValue b, TemplateRep b ~ Single+  ) =>+  ToTemplateValue (a, b) where+  type TemplateRep (a, b) = List+  toTemplateValue (a, b) = List+    [ toTemplateValue a+    , toTemplateValue b+    ]++instance+  ( ToTemplateValue a, TemplateRep a ~ Single+  , ToTemplateValue b, TemplateRep b ~ Single+  , ToTemplateValue c, TemplateRep c ~ Single+  ) =>+  ToTemplateValue (a, b, c) where+  type TemplateRep (a, b, c) = List+  toTemplateValue (a, b, c) = List+    [ toTemplateValue a+    , toTemplateValue b+    , toTemplateValue c+    ]++instance+  ( ToTemplateValue a, TemplateRep a ~ Single+  , ToTemplateValue b, TemplateRep b ~ Single+  , ToTemplateValue c, TemplateRep c ~ Single+  , ToTemplateValue d, TemplateRep d ~ Single+  ) =>+  ToTemplateValue (a, b, c, d) where+  type TemplateRep (a, b, c, d) = List+  toTemplateValue (a, b, c, d) = List+    [ toTemplateValue a+    , toTemplateValue b+    , toTemplateValue c+    , toTemplateValue d+    ]++instance+  ( ToTemplateValue a, TemplateRep a ~ Single+  , ToTemplateValue b, TemplateRep b ~ Single+  , ToTemplateValue c, TemplateRep c ~ Single+  , ToTemplateValue d, TemplateRep d ~ Single+  , ToTemplateValue e, TemplateRep e ~ Single+  ) =>+  ToTemplateValue (a, b, c, d, e) where+  type TemplateRep (a, b, c, d, e) = List+  toTemplateValue (a, b, c, d, e) = List+    [ toTemplateValue a+    , toTemplateValue b+    , toTemplateValue c+    , toTemplateValue d+    , toTemplateValue e+    ]++instance+  ( ToTemplateValue a, TemplateRep a ~ Single+  , ToTemplateValue b, TemplateRep b ~ Single+  , ToTemplateValue c, TemplateRep c ~ Single+  , ToTemplateValue d, TemplateRep d ~ Single+  , ToTemplateValue e, TemplateRep e ~ Single+  , ToTemplateValue f, TemplateRep f ~ Single+  ) =>+  ToTemplateValue (a, b, c, d, e, f) where+  type TemplateRep (a, b, c, d, e, f) = List+  toTemplateValue (a, b, c, d, e, f) = List+    [ toTemplateValue a+    , toTemplateValue b+    , toTemplateValue c+    , toTemplateValue d+    , toTemplateValue e+    , toTemplateValue f+    ]++instance+  ( ToTemplateValue a, TemplateRep a ~ Single+  , ToTemplateValue b, TemplateRep b ~ Single+  , ToTemplateValue c, TemplateRep c ~ Single+  , ToTemplateValue d, TemplateRep d ~ Single+  , ToTemplateValue e, TemplateRep e ~ Single+  , ToTemplateValue f, TemplateRep f ~ Single+  , ToTemplateValue g, TemplateRep g ~ Single+  ) =>+  ToTemplateValue (a, b, c, d, e, f, g) where+  type TemplateRep (a, b, c, d, e, f, g) = List+  toTemplateValue (a, b, c, d, e, f, g) = List+    [ toTemplateValue a+    , toTemplateValue b+    , toTemplateValue c+    , toTemplateValue d+    , toTemplateValue e+    , toTemplateValue f+    , toTemplateValue g+    ]+ data ValueModifier   = Normal   | Explode@@ -92,21 +304,24 @@   } deriving (Read, Show, Eq)  data TemplateSegment-  = Literal String-  | Embed Modifier [Variable]+  = Literal String -- ^ A literal string. No URI escaping will be performed+  | Embed Modifier [Variable] -- ^ An interpolation can have multiple variables (separated by commas in the textual format)   deriving (Read, Show, Eq) +-- | A URI template is fundamentally a bunch of segments that are either constants+-- or else an interpolation type UriTemplate = [TemplateSegment] +-- | How an interpolated value should be rendered data Modifier-  = Simple-  | Reserved-  | Fragment-  | Label-  | PathSegment-  | PathParameter-  | Query-  | QueryContinuation+  = Simple -- ^ No prefix+  | Reserved -- ^ Prefixed by @+@+  | Fragment -- ^ Prefixed by @#@+  | Label -- ^ Prefixed by @.@+  | PathSegment -- ^ Prefixed by @/@+  | PathParameter -- ^ Prefixed by @;@+  | Query -- ^ Prefixed by @?@+  | QueryContinuation -- ^ Prefixed by @&@   deriving (Read, Show, Eq)  

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                uri-templater-version:             0.3.0.0+version:             0.3.1.0 synopsis:            Parsing & Quasiquoting for RFC 6570 URI Templates description:         Parsing & Quasiquoting for RFC 6570 URI Templates homepage:            https://github.com/iand675/uri-templater@@ -37,7 +37,9 @@                      containers,                      unordered-containers,                      text,-                     bytestring+                     bytestring,+                     uuid-types,+                     time   hs-source-dirs:    src  test-suite test-uri-templates