diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..002f475
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+.stack-work
+dist
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..a31a05d
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2016 Patrick Chilton
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/solga.cabal b/solga.cabal
new file mode 100644
index 0000000..6bce29d
--- /dev/null
+++ b/solga.cabal
@@ -0,0 +1,30 @@
+name:                solga
+version:             0.1.0.0
+synopsis:            Simple typesafe web routing
+-- description:
+license:             MIT
+license-file:        LICENSE
+author:              Patrick Chilton
+maintainer:          chpatrick@gmail.com
+copyright:           Copyright (C) 2016 Patrick Chilton
+category:            Web
+build-type:          Simple
+homepage:            https://github.com/chpatrick/solga
+bug-reports:         https://github.com/chpatrick/solga/issues
+-- extra-source-files:
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Solga
+  build-depends:       base,
+                       text,
+                       wai,
+                       bytestring,
+                       containers,
+                       aeson,
+                       wai-extra,
+                       http-types,
+                       resourcet
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall
diff --git a/src/Solga.hs b/src/Solga.hs
new file mode 100644
index 0000000..be180bb
--- /dev/null
+++ b/src/Solga.hs
@@ -0,0 +1,370 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module Solga
+  ( -- * Serving APIs
+    serve, serveThrow
+   -- * Basic routers
+  , type (:>), type (/>)
+  , Get
+  , Post
+  , JSON(..)
+  , Raw(..)
+  , RawResponse(..)
+  , End(..)
+  , WithIO(..)
+  , Seg(..)
+  , OneOfSegs(..)
+  , FromSegment(..)
+  , Capture(..)
+  , Method(..)
+  , ExtraHeaders(..)
+  , NoCache(..)
+  , ReqBodyJSON(..)
+  , MultiPartData
+  , ReqBodyMultipart(..)
+  , Endpoint
+  , (:<|>)(..)
+  -- * Abbreviation
+  , Abbreviated(..)
+  -- * Error handling
+  , SolgaError
+  , badRequest
+  , notFound
+  -- * Router implementation
+  , Router(..)
+  , Responder
+  , tryRouteNext
+  , tryRouteNextIO
+  ) where
+
+import           Control.Applicative
+import           Control.Exception
+import           Control.Monad
+import           Control.Monad.Trans.Resource
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Encode as Aeson
+import qualified Data.ByteString.Builder as Builder
+import qualified Data.ByteString.Char8 as Char8
+import qualified Data.Map.Strict as Map
+import           Data.Monoid
+import           Data.Proxy
+import qualified Data.Text as Text
+import           Data.Text.Encoding
+import           GHC.Generics
+import           GHC.TypeLits
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Parse as Wai
+import qualified Network.HTTP.Types as HTTP
+
+---------------------------------------------------
+
+-- | The right hand side of `Application`. `Request` is already known.
+type Responder = (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
+
+-- | Routers are the basic typeclass of Solga: their types describe
+-- what type of requests they accept, and their values describe how to handle them.
+--
+-- You can use `Generic` to get free instance of `Router` for any data type with one constructor
+-- and `Router`s as fields. The fields will be considered alternatives, as if you wrote `:<|>` between them.
+class Router r where
+  -- | Given a request, if the router supports the given request
+  -- return a function that constructs a response with a concrete router.
+  tryRoute :: Wai.Request -> Maybe (r -> Responder)
+  default tryRoute :: (Generic r, Router (Rep r ())) => Wai.Request -> Maybe (r -> Responder)
+  tryRoute = tryRouteNext (from :: r -> Rep r ())
+
+-- | Try to route using a type @r@ by providing a function to turn it into a `Router` @r'@.
+-- Useful for passing routing on to the next step.
+tryRouteNext :: Router r' => (r -> r') -> Wai.Request -> Maybe (r -> Responder)
+tryRouteNext f req = (. f) <$> tryRoute req
+
+-- | Like `tryRouteNext` but in `IO`.
+tryRouteNextIO :: Router r' => (r -> IO r') -> Wai.Request -> Maybe (r -> Responder)
+tryRouteNextIO f req = do
+  nextRouter <- tryRoute req
+  Just $ \router cont -> do
+    next <- f router
+    nextRouter next cont
+
+-- | Serve a `Router` with Solga, returning `SolgaError`s as HTTP responses.
+serve :: Router r => r -> Wai.Application
+serve router req cont = catch (serveThrow router req cont) $ \case
+  SolgaError { errorStatus, errorMessage } ->
+    cont $ Wai.responseBuilder errorStatus [] $
+      Builder.byteString $ encodeUtf8 errorMessage
+
+-- | Serve a `Router` with Solga, throwing `SolgaError`s.
+serveThrow :: Router r => r -> Wai.Application
+serveThrow router req cont = case tryRoute req of
+  Nothing -> throwIO $ notFound ""
+  Just r -> r router cont
+
+-- | Compose routers. This is just type application,
+-- ie.: @Foo :> Bar :> Baz == Foo (Bar Baz)@
+type f :> g = f g
+infixr 2 :>
+
+-- | Serve a given WAI `Wai.Application`.
+newtype Raw = Raw { rawApp :: Wai.Application }
+
+instance Router Raw where
+  tryRoute req = Just $ \(Raw app) -> app req
+
+-- | Serve a given WAI `Wai.Response`.
+newtype RawResponse = RawResponse { rawResponse :: Wai.Response }
+instance Router RawResponse where
+  tryRoute _ = Just $ \(RawResponse response) cont -> cont response
+
+-- | Only accept the end of a path.
+newtype End next = End { endNext :: next }
+instance Router next => Router (End next) where
+  tryRoute req = case Wai.pathInfo req of
+    [] -> tryRouteNext endNext req
+    _ -> Nothing
+
+-- | Match a constant directory in the path.
+--
+--   When specifying APIs, use the `/>` combinator to specify sub-paths:
+--   @"foo" `/>` `JSON` Bar@
+newtype Seg (seg :: Symbol) next = Seg { segNext :: next }
+  deriving (Eq, Ord, Show)
+
+-- | Match a path, segment, e.g @"foo" `/>` `JSON` Bar@
+type seg /> g = Seg seg :> g
+infixr 2 />
+
+instance (KnownSymbol seg, Router next) => Router (Seg seg next) where
+  tryRoute req = case Wai.pathInfo req of
+    s : segs | Text.unpack s == symbolVal (Proxy :: Proxy seg) ->
+      tryRouteNext segNext req { Wai.pathInfo = segs }
+    _ -> Nothing
+
+-- | Try to route with @left@, or try to route with @right@.
+data left :<|> right = (:<|>) { altLeft :: left, altRight :: right }
+  deriving (Eq, Ord, Show)
+
+infixr 1 :<|>
+
+instance (Router left, Router right) => Router (left :<|> right) where
+  tryRoute req = tryRouteNext altLeft req <|> tryRouteNext altRight req
+
+-- | Match any of a set of path segments.
+data OneOfSegs (segs :: [ Symbol ]) next = OneOfSegs { oneOfSegsNext :: next }
+
+instance (KnownSymbol seg, Router next, Router (OneOfSegs segs next)) => Router (OneOfSegs (seg ': segs) next) where
+  tryRoute = tryRouteNext $ \(OneOfSegs next) -> (Seg next :: Seg seg next) :<|> (OneOfSegs next :: OneOfSegs segs next)
+
+instance Router next => Router (OneOfSegs '[] next) where
+  tryRoute _ = Nothing
+
+-- | The class of types that can be parsed from a path segment.
+class FromSegment a where
+  fromSegment :: Text.Text -> Maybe a
+
+instance FromSegment Text.Text where
+  fromSegment = Just
+
+-- | Capture a path segment and pass it on.
+newtype Capture a next = Capture { captureNext :: a -> next }
+
+instance (FromSegment a, Router next) => Router (Capture a next) where
+  tryRoute req = case Wai.pathInfo req of
+    seg : segs -> do
+      capture <- fromSegment seg
+      tryRouteNext (\c -> captureNext c capture) req { Wai.pathInfo = segs }
+    _ -> Nothing
+
+-- | Accepts requests with a certain method.
+newtype Method (method :: Symbol) next = Method { methodNext :: next }
+  deriving (Eq, Ord, Show)
+
+instance (KnownSymbol method, Router next) => Router (Method method next) where
+  tryRoute req = do
+    guard (Char8.unpack (Wai.requestMethod req) == symbolVal (Proxy :: Proxy method))
+    tryRouteNext methodNext req
+
+-- | Return a given JSON object
+newtype JSON a = JSON { jsonResponse :: a }
+  deriving (Eq, Ord, Show)
+
+instance Aeson.ToJSON a => Router (JSON a) where
+  tryRoute _ = Just $ \json cont ->
+    cont $ Wai.responseBuilder HTTP.status200 headers $ Aeson.encodeToBuilder $ Aeson.toJSON $ jsonResponse json
+      where headers = [ ( HTTP.hContentType, "application/json" ) ]
+
+-- | Set extra headers on responses.
+-- Existing headers will be overriden if specified here.
+data ExtraHeaders next = ExtraHeaders
+  { extraHeaders :: HTTP.ResponseHeaders
+  , extraHeadersNext :: next
+  }
+
+instance Router next => Router (ExtraHeaders next) where
+  tryRoute req = do
+    nextRouter <- tryRoute req
+    return $ \(ExtraHeaders headers next) cont -> do
+      let addHeaders oldHeaders = Map.assocs (Map.fromList headers `Map.union` Map.fromList oldHeaders)
+      nextRouter next $ \response ->
+        cont $ Wai.mapResponseHeaders addHeaders response
+
+-- | Prevent caching for sub-routers.
+newtype NoCache next = NoCache { noCacheNext :: next }
+
+instance Router next => Router (NoCache next) where
+  tryRoute = tryRouteNext (ExtraHeaders [cacheControlDisableCaching] . noCacheNext)
+    where
+      cacheControlDisableCaching = ("Cache-Control", "no-store, no-cache, must-revalidate, max-age=0")
+
+-- | Parse a JSON request body.
+newtype ReqBodyJSON a next = ReqBodyJSON { reqBodyJSONNext :: a -> next }
+
+instance (Aeson.FromJSON a, Router next) => Router (ReqBodyJSON a next) where
+  tryRoute req = tryRouteNextIO getNext req
+    where
+      getNext rbj = do
+        reqBody <- Wai.requestBody req
+        case Aeson.eitherDecodeStrict reqBody of
+          Left err -> throwIO $ badRequest $ "Could not decode JSON request: " <> Text.pack (show err)
+          Right val -> return (reqBodyJSONNext rbj val)
+
+-- | Produce a response with `IO`.
+newtype WithIO next = WithIO { withIONext :: IO next }
+
+instance Router next => Router (WithIO next) where
+  tryRoute = tryRouteNextIO withIONext
+
+-- | A parsed "multipart/form-data" request.
+type MultiPartData = ([Wai.Param], [Wai.File FilePath])
+
+-- | Accept a "multipart/form-data" request.
+-- Files will be stored in a temporary directory and will be deleted
+-- automatically after the request is processed.
+data ReqBodyMultipart a next = ReqBodyMultipart
+  { reqMultiPartParse :: MultiPartData -> Either String a
+  , reqMultiPartNext :: a -> next
+  }
+
+instance Router next => Router (ReqBodyMultipart a next) where
+  tryRoute req = flip fmap (tryRoute req) $ \nextRouter rmp cont ->
+    runResourceT $ withInternalState $ \s -> do
+      multiPart <- Wai.parseRequestBody (Wai.tempFileBackEnd s) req
+      case reqMultiPartParse rmp multiPart of
+        Left err -> throwIO $ badRequest $ "Could not decode form request: " <> Text.pack err
+        Right val -> nextRouter (reqMultiPartNext rmp val) cont
+
+-- | Useful synonym for dynamic endpoints: accept requests with a given method, compute a JSON response in `IO` and don't cache.
+type Endpoint method a = End :> NoCache :> Method method :> WithIO :> a
+
+-- | Handle a "GET" request and produce a "JSON" response, with `IO`.
+type Get a = Endpoint "GET" (JSON a)
+-- | Handle a "POST" request and produce a "JSON" response, with `IO`.
+type Post a = Endpoint "POST" (JSON a)
+
+-- | Most `Router`s are really just newtypes. By using `brief`, you can
+--   construct trees of `Router`s by providing only their inner types, much
+--   like Servant.
+class Abbreviated a where
+  type Brief a :: *
+  type instance Brief a = a
+  brief :: Brief a -> a
+  default brief :: a -> a
+  brief = id
+
+instance Abbreviated Raw where
+  type Brief Raw = Wai.Application
+  brief = Raw
+
+instance Abbreviated RawResponse where
+  type Brief RawResponse = Wai.Response
+  brief = RawResponse
+
+instance Abbreviated next => Abbreviated (End next) where
+  type Brief (End next) = Brief next
+  brief = End . brief
+
+instance Abbreviated next => Abbreviated (Seg seg next) where
+  type Brief (Seg seg next) = Brief next
+  brief = Seg . brief
+
+instance (Abbreviated left, Abbreviated right) => Abbreviated (left :<|> right) where
+  type Brief (left :<|> right) = Brief left :<|> Brief right
+  brief (l :<|> r) = brief l :<|> brief r
+
+instance Abbreviated next => Abbreviated (OneOfSegs segs next) where
+  type Brief (OneOfSegs segs next) = Brief next
+  brief = OneOfSegs . brief
+
+instance Abbreviated next => Abbreviated (Capture a next) where
+  type Brief (Capture a next) = a -> Brief next
+  brief = Capture . fmap brief
+
+instance Abbreviated next => Abbreviated (Method method next) where
+  type Brief (Method method next) = Brief next
+  brief = Method . brief
+
+instance Abbreviated (JSON a) where
+  type Brief (JSON a) = a
+  brief = JSON
+
+instance Abbreviated (ExtraHeaders next)
+
+instance Abbreviated next => Abbreviated (NoCache next) where
+  type Brief (NoCache next) = Brief next
+  brief = NoCache . brief
+
+instance Abbreviated next => Abbreviated (ReqBodyJSON a next) where
+  type Brief (ReqBodyJSON a next) = a -> Brief next
+  brief = ReqBodyJSON . fmap brief
+
+instance Abbreviated next => Abbreviated (WithIO next) where
+  type Brief (WithIO next) = IO (Brief next)
+  brief = WithIO . fmap brief
+
+instance Abbreviated (ReqBodyMultipart a next)
+
+-- Generic routers
+
+deriving instance Router r => Router (K1 i r p)
+deriving instance Router (f p) => Router (M1 i c f p)
+
+instance (Router (left p), Router (right p)) => Router ((left :*: right) p) where
+  tryRoute req = routeLeft <|> routeRight
+    where
+      routeLeft = tryRouteNext (\(left :*: _) -> left) req
+      routeRight = tryRouteNext (\(_ :*: right) -> right) req
+
+-- Error handling
+
+-- | A `Router`-related exception with a corresponding HTTP error code.
+data SolgaError = SolgaError
+  { errorStatus :: HTTP.Status
+  , errorMessage :: Text.Text
+  } deriving (Eq, Ord, Show)
+
+instance Exception SolgaError
+
+-- | Create a @400 Bad Request@ error with a given message.
+badRequest :: Text.Text -> SolgaError
+badRequest msg = SolgaError
+  { errorStatus = HTTP.badRequest400
+  , errorMessage = msg
+  }
+
+-- | Create a @404 Not Found@ error with a given message.
+notFound :: Text.Text -> SolgaError
+notFound msg = SolgaError
+  { errorStatus = HTTP.notFound404
+  , errorMessage = msg
+  }
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..3364142
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,32 @@
+# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
+
+# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
+resolver: lts-5.1
+
+# Local packages, usually specified by relative directory name
+packages:
+- '.'
+
+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: >= 1.0.0
+
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]