urlpath 8.0.1 → 8.1.0
raw patch · 3 files changed
+184/−53 lines, 3 files
Files
- README.md +93/−0
- src/Data/Url.hs +40/−18
- urlpath.cabal +51/−35
+ README.md view
@@ -0,0 +1,93 @@+# urlpath++[](https://travis-ci.org/athanclark/urlpath)+[](https://coveralls.io/r/athanclark/urlpath)+[](https://gitter.im/athanclark/urlpath)+[](https://tldrlegal.com/license/mit-license)+[](https://hackage.haskell.org/package/urlpath)+[](https://waffle.io/athanclark/urlpath)++Dirt-simple, embarrassing, horribly unimaginative URL combinator library for +Haskell.+++## Installation++```bash+λ> cabal install urlpath+```++## Usage++You can use the combinators purely, if you're into that:+++```haskell+λ> expandRelative $ "foo.php" <?> ("key1","bar") <&> ("key2","baz")++↪ "foo.asp?key1=bar&key2=baz"+```++Or you can use them with a configurable root, via the Reader monad:++```haskell+λ> runReader+ (runAbsoluteUrl $ url $ "foo.asp" <?> ("key1","bar") <&> ("key2","baz"))+ "http://example.com"++↪ "http://example.com/foo.asp?key1=bar&key2=baz"+```+`url` puts the `UrlString` in a MonadReader that we can use for applying our⋅+host. We use different monads for different deployment schemes (currently we⋅+have 3 - `RelativeUrlT`, `GroundedUrlT`, and `AbsoluteUrlT`), which we can⋅+integrate in different libraries, like Lucid:++```haskell+λ> (runAbsoluteUrl $ renderTextT $ do+ foo <- lift $ url $ "foo" <?> ("bar","baz")+ script_ [src_ foo] "" )+ ) "example.com"++↪ "<script src=\"example.com/foo?bar=baz\"></script>"+```++and, in Scotty:++```haskell+main :: IO ()+main = scottyT 3000+ rootConf+ rootConf+ run++ where+ rootConf = flip runAbsoluteT "http://example.com"++ run :: ( MonadIO m+ , MonadReader T.Text m+ , Url T.Text m ) =>+ ScottyT LT.Text m ()+ run = get "/" $ do+ path <- lift $ url $ "foo" <?> ("bar","baz")+ text $ LT.fromStrict path+```++```+λ> curl localhost:3000/+↪ "http://example.com/foo?bar=baz"+```++## How to run tests++```bash+λ> cabal install hspec --enable-tests && cabal test --show-details=always+```++## Contributing++I would prefer it that any inquiries and questions go to the+[Gitter Chat room](https://gitter.im/athanclark/urlpath), while any suggestions, +complaints, or requests go in the+[GitHub Issues](https://github.com/athanclark/urlpath/issues) /+[Waffle Dashboard](https://waffle.io/athanclark/urlpath). All ideas are welcome! +(Except really gross ones. I've got limits.)
src/Data/Url.hs view
@@ -34,8 +34,8 @@ import Path.Extended -import Data.Functor.Identity-import Data.Functor.Compose+import Data.Functor.Identity (Identity (..))+import Data.Functor.Compose (Compose) import Data.Maybe (maybe) import Data.URI (URI (..)) import Data.URI.Auth (URIAuth (..))@@ -45,24 +45,31 @@ import qualified Data.Vector as V import Data.List.Split (splitOn) import qualified Data.Text as T-import Control.Applicative-import Control.Monad.Base-import Control.Monad.Catch-import Control.Monad.Cont+import Data.Monoid ((<>))+import Control.Applicative (Alternative ((<|>), empty))+import Control.Monad (MonadPlus ())+import Control.Monad.Fix (MonadFix ())+import Control.Monad.Base (MonadBase (liftBase), liftBaseDefault)+import Control.Monad.Catch (MonadMask (uninterruptibleMask, mask), MonadCatch (catch), MonadThrow (throwM))+import Control.Monad.Cont (MonadCont (callCC), ContT) import Control.Monad.Trans.Error (Error, ErrorT)-import Control.Monad.Except-import Control.Monad.Trans.Control+import Control.Monad.Except (MonadError (catchError, throwError), ExceptT)+import Control.Monad.Trans (MonadTrans (lift))+import Control.Monad.Trans.Control (MonadBaseControl (liftBaseWith, restoreM, StM), MonadTransControl (liftWith, restoreT, StT), ComposeSt, defaultRestoreM, defaultLiftBaseWith) import qualified Control.Monad.Trans.Control.Aligned as Aligned-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe-import Control.Monad.List-import Control.Monad.Reader-import Control.Monad.Writer-import Control.Monad.State-import Control.Monad.RWS-import Control.Monad.Logger-import Control.Monad.Trans.Resource-import Control.Monad.Morph+import Control.Monad.Trans.Identity (IdentityT)+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.List (ListT)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Reader (MonadReader (ask, local), ReaderT)+import Control.Monad.Writer (MonadWriter (pass, listen, tell), WriterT)+import Control.Monad.State (MonadState (put, get), StateT)+import Control.Monad.RWS (MonadRWS, RWST)+import Control.Monad.Logger (MonadLogger (monadLoggerLog), NoLoggingT, LoggingT)+import Control.Monad.Trans.Resource (MonadResource (liftResourceT), ResourceT)+import Control.Monad.Morph (MMonad (embed), MFunctor (hoist))+import System.IO.Unsafe (unsafePerformIO)+import Unsafe.Coerce (unsafeCoerce) @@ -440,3 +447,18 @@ $ getQuery loc ) (maybe Strict.Nothing (Strict.Just . T.pack) (getFragment loc))+++unpackLocation :: URI -> (Strict.Maybe T.Text, Bool, URIAuth, Location Abs File)+unpackLocation (URI scheme slashes auth xs qs mFrag) =+ ( scheme+ , slashes+ , auth+ , let path = foldl (\acc x -> unsafeCoerce acc </> unsafePerformIO (parseRelFile $ T.unpack x))+ (unsafePerformIO $ unsafeCoerce <$> parseAbsDir "/")+ xs+ withQs = foldl (\acc (k Strict.:!: mV) -> acc <&> (T.unpack k, Strict.maybe Nothing (Just . T.unpack) mV))+ (fromPath path)+ qs+ in setFragment (Strict.maybe Nothing (Just . T.unpack) mFrag) withQs+ )
urlpath.cabal view
@@ -1,38 +1,54 @@-Name: urlpath-Version: 8.0.1-Author: Athan Clark <athan.clark@gmail.com>-Maintainer: Athan Clark <athan.clark@gmail.com>-License: MIT-License-File: LICENSE-Category: Web, Data-Synopsis: Painfully simple URL deployment.--- Description:+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 426d803b715c92c3f8d44dadc6463726205fdaaf96a6155d18b01c40dc122c0e -Cabal-Version: >= 1.10-Build-Type: Simple+name: urlpath+version: 8.1.0+synopsis: Painfully simple URL deployment.+description: Please see the README on Github at <https://github.com/githubuser/urlpath#readme>+category: Web, Data+homepage: https://github.com/athanclark/urlpath#readme+bug-reports: https://github.com/athanclark/urlpath/issues+author: Athan Clark+maintainer: athan.clark@localcooking.com+copyright: Copyright (c) 2018 Athan Clark+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10 -Library- Default-Language: Haskell2010- HS-Source-Dirs: src- GHC-Options: -Wall- Exposed-Modules: Data.Url- Build-Depends: base >= 4.8 && < 5- , attoparsec-uri >= 0.0.4- , exceptions- , mmorph- , monad-control- , monad-control-aligned- , monad-logger- , mtl- , path-extra >= 0.0.6- , resourcet- , split- , strict- , text- , transformers- , transformers-base- , vector+extra-source-files:+ README.md -Source-Repository head- Type: git- Location: https://github.com/athanclark/urlpath.git+source-repository head+ type: git+ location: https://github.com/athanclark/urlpath++library+ exposed-modules:+ Data.Url+ other-modules:+ Paths_urlpath+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ attoparsec-uri >=0.0.4+ , base >=4.8 && <5+ , exceptions+ , mmorph+ , monad-control+ , monad-control-aligned+ , monad-logger+ , mtl+ , path-extra >=0.0.6+ , resourcet+ , split+ , strict+ , text+ , transformers+ , transformers-base+ , vector+ default-language: Haskell2010