urlpath 1.1.0 → 2.0.0
raw patch · 3 files changed
+45/−34 lines, 3 files
Files
- src/Data/Url.hs +9/−9
- src/Data/Url/Types.hs +35/−24
- urlpath.cabal +1/−1
src/Data/Url.hs view
@@ -26,7 +26,7 @@ -- * Classes --- | @Url@ is a relationship between an underlying (monomorphic) string type+-- | @Url@ is a relationship between an underlying string type -- @plain@, and a deployment context @m@. We try to make the deployment style -- coercible at the top level - if the expression has a type -- @Url String (AbsoluteUrlT String Identity)@ or@@ -35,8 +35,8 @@ class ( TextualMonoid plain , MonadReader plain m ) => Url plain (m :: * -> *) where- url :: UrlString plain -- ^ Url type, parameterized over a string type @plain@- -> m plain -- ^ Rendered Url in some context.+ queryUrl :: QueryString plain -- ^ Url type, parameterized over a string type @plain@+ -> m plain -- ^ Rendered Url in some context. plainUrl :: plain -- ^ raw small string -> m plain -- ^ Rendered string in some context. @@ -53,8 +53,8 @@ instance ( Monad m , TextualMonoid plain ) => Url plain (RelativeUrlT plain m) where- url = RelativeUrlT . const . return . expandRelative- plainUrl x = RelativeUrlT $ const $ return $ expandRelative $ UrlString x []+ queryUrl = RelativeUrlT . const . return . expandRelative+ plainUrl x = RelativeUrlT $ const $ return $ expandRelative $ QueryString x [] Nothing instance ( Monad m , TextualMonoid plain ) => UrlReader plain (RelativeUrlT plain m) where@@ -63,8 +63,8 @@ instance ( Monad m , TextualMonoid plain ) => Url plain (GroundedUrlT plain m) where- url = GroundedUrlT . const . return . expandGrounded- plainUrl x = GroundedUrlT $ const $ return $ expandGrounded $ UrlString x []+ queryUrl = GroundedUrlT . const . return . expandGrounded+ plainUrl x = GroundedUrlT $ const $ return $ expandGrounded $ QueryString x [] Nothing instance ( Monad m , TextualMonoid plain ) => UrlReader plain (GroundedUrlT plain m) where@@ -73,8 +73,8 @@ instance ( Monad m , TextualMonoid plain ) => Url plain (AbsoluteUrlT plain m) where- url = expandAbsolute- plainUrl x = expandAbsolute $ UrlString x []+ queryUrl = expandAbsolute+ plainUrl x = expandAbsolute $ QueryString x [] Nothing instance ( Monad m , TextualMonoid plain ) => UrlReader plain (AbsoluteUrlT plain m) where
src/Data/Url/Types.hs view
@@ -25,45 +25,56 @@ -- -- The type constructor is parameterized over it's underlying @IsString@ & -- @Monoid@ instance.-data UrlString a where- UrlString :: ( TextualMonoid a ) =>- a- -> [(a, a)]- -> UrlString a+data QueryString a where+ QueryString :: ( TextualMonoid a ) =>+ a -- location+ -> [(a, a)] -- query parameters+ -> Maybe a -- hash+ -> QueryString a --- | We can't provide a @Show@ instance for @UrlString@ because that would force+-- | We can't provide a @Show@ instance for @QueryString@ because that would force -- us to use @String@.-showUrlString :: UrlString a+showUrlString :: QueryString a -> a-showUrlString (UrlString !t []) = t-showUrlString (UrlString !t ((!k,!v):xs)) =- t <> "?" <> k <> "=" <> v <>- foldl (\acc (x,y) -> acc <> "&" <> x <> "=" <> y) "" xs+showUrlString (QueryString !t [] !mh) =+ maybe t (\h -> t <> "#" <> h) mh+showUrlString (QueryString !t ((!k,!v):xs) !mh) =+ let b = t <> "?" <> k <> "=" <> v <>+ foldl (\acc (x,y) -> acc <> "&" <> x <> "=" <> y) "" xs+ in+ maybe b (\h -> b <> "#" <> h) mh --- | Makes a @UrlString@ out of a raw target path and a GET parameter pair.+-- | Makes a @QueryString@ out of a raw target path and a GET parameter pair. (<?>) :: ( TextualMonoid a ) => a -- ^ Target string -> (a, a) -- ^ GET Parameter- -> UrlString a-(<?>) !t !kv = UrlString t [kv]+ -> QueryString a+(<?>) !t !kv = QueryString t [kv] Nothing infixl 9 <?> --- | Adds another GET parameter pair to a @UrlString@.+-- | Adds another GET parameter pair to a @QueryString@. (<&>) :: ( TextualMonoid a ) =>- UrlString a -- ^ Old Url+ QueryString a -- ^ Old Url -> (a, a) -- ^ Additional GET Parameter- -> UrlString a-(<&>) (UrlString !t !p) !kv = UrlString t $ p ++ [kv]+ -> QueryString a+(<&>) (QueryString !t !p _) !kv = QueryString t (p ++ [kv]) Nothing infixl 8 <&> +-- | Adds a hash parameter to a @QueryString@.+(<#>) :: ( TextualMonoid a ) =>+ QueryString a+ -> a+ -> QueryString a+(<#>) (QueryString !t !p _) !h = QueryString t p $ Just h + fromRoute :: ( TextualMonoid a ) => ([a], [(a, a)])- -> UrlString a-fromRoute (l,qs) = UrlString (intercalate' "/" l) qs+ -> QueryString a+fromRoute (l,qs) = QueryString (intercalate' "/" l) qs Nothing where intercalate' c [s] = s intercalate' c (s:ss) = s <> c <> intercalate' c ss@@ -71,13 +82,13 @@ -- | Render the Url String flatly - without anything prepended to the target. expandRelative :: ( TextualMonoid plain ) =>- UrlString plain+ QueryString plain -> plain expandRelative = showUrlString -- | Render the Url String as grounded - prepended with a "root" @//@ character. expandGrounded :: ( TextualMonoid plain ) =>- UrlString plain+ QueryString plain -> plain expandGrounded !x = "/" <> showUrlString x @@ -85,7 +96,7 @@ -- context. expandAbsolute :: ( MonadReader plain m , TextualMonoid plain ) =>- UrlString plain+ QueryString plain -> m plain expandAbsolute !x = do host <- ask@@ -108,7 +119,7 @@ -- > SiteConfig "example.com" "cdn.example.com" expandAbsoluteWith :: ( MonadReader a m , TextualMonoid plain ) =>- UrlString plain+ QueryString plain -> (a -> plain) -> m plain expandAbsoluteWith !x f = do
urlpath.cabal view
@@ -1,5 +1,5 @@ Name: urlpath-Version: 1.1.0+Version: 2.0.0 Author: Athan Clark <athan.clark@gmail.com> Maintainer: Athan Clark <athan.clark@gmail.com> License: MIT