diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -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"
+
+↪ ""
+```
+
+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.)
diff --git a/src/Data/Url.hs b/src/Data/Url.hs
--- a/src/Data/Url.hs
+++ b/src/Data/Url.hs
@@ -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
+ )
diff --git a/urlpath.cabal b/urlpath.cabal
--- a/urlpath.cabal
+++ b/urlpath.cabal
@@ -1,38 +1,54 @@
-Name: urlpath
-Version: 8.0.1
-Author: Athan Clark
-Maintainer: Athan Clark
-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
+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