mv **.hs src/

1 files changed, 0 insertions, 157 deletions

diff --git a/Main/Util.hs b/Main/Util.hs
deleted file mode 100644
index b02f80c..0000000
--- a/Main/Util.hs
+++ /dev/null
@@ -1,157 +0,0 @@
--- |
--- Module:      Main.Util
--- Copyright:   (c) 2014 Tomislav Viljetić
--- License:     BSD3
--- Maintainer:  Tomislav Viljetić <tomislav@viljetic.de>
---
--- Grab bag of utilities used by "Main".  This module is used to keep
--- "Main" as application-focused as possible.
---
-
-{-# LANGUAGE OverloadedStrings #-}
-
-
-module Main.Util
-    (
-      -- * Data.List utilities
-      splitLast,
-      -- * Network.Wai utilities
-      pathInfoString,
-      handleMethod,
-      okJSON,
-      noContent,
-      badRequest,
-      badRequest',
-      forbidden,
-      notFound,
-      notAllowed,
-      conflict,
-      conflict',
-      internalServerError,
-      internalServerError',
-    ) where
-
-import Data.Aeson (encode, ToJSON)
-import Data.Monoid
-import qualified Data.ByteString.Char8 as BS8
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Text as T
-import qualified Data.Text.Lazy.Encoding as LT
-import qualified Data.Text.Lazy as LT
-import Network.HTTP.Types
-import Network.Wai
-import Safe
-
-
-
-splitLast :: [a] -> ([a], a)
-splitLast xs =
-    (init xs, last xs)
-
-
--- | Like 'pathInfo', but returns 'String's instead.
-pathInfoString :: Request -> [String]
-pathInfoString = map T.unpack . pathInfo
-
-
--- | Route a request based on it's method.
--- If no application is associated with the request's method,
--- then 'notAllowed' is used.
-handleMethod :: [(Method, Application)] -> Application
-handleMethod apps req respond =
-    app req respond
-  where
-    app = lookupJustDef (notAllowed allow) (requestMethod req) apps
-    allow = map fst apps
-
-
-okJSON :: ToJSON a => a -> Application
-okJSON = respondJSON [] ok200
-
-
-noContent :: Application
-noContent = respondEmpty [] noContent204
-
-
-badRequest :: Application
-badRequest = respondEmpty [] badRequest400
-
-
-badRequest' :: LT.Text -> Application
-badRequest' = respondText [] badRequest400
-
-
-forbidden :: Application
-forbidden = respondEmpty [] forbidden403
-
-
-notFound :: Application
-notFound = respondEmpty [] notFound404
-
-
-notAllowed :: [Method] -> Application
-notAllowed allow =
-    respondEmpty [(hAllow, BS8.intercalate ", " allow)] methodNotAllowed405
-
-
-conflict :: Application
-conflict =
-    respondEmpty [] conflict409
-
-
-conflict' :: BS.ByteString -> Application
-conflict' msg =
-    respondEmpty [] status
-  where
-    status = mkStatus 409 $ "Conflict (" <> msg <> ")"
-
-
-internalServerError :: Application
-internalServerError =
-    respondEmpty [] internalServerError500
-
-
-internalServerError' :: BS.ByteString -> Application
-internalServerError' msg =
-    respondEmpty [] status
-  where
-    status = mkStatus 500 $ "Internal Server Error (" <> msg <> ")"
-
-
-
--- XXX currently it's not always possible to send a truly empty response.
--- because 'Network.Wai.Handler.Warp.Response.hasBody' only discriminates
--- by status code and request method.  This means that empty responses may
--- contain superfluous headers like @Transfer-Encoding@.  This behavior
--- should not cause any problems, though.
-respondEmpty :: ResponseHeaders -> Status -> Application
-respondEmpty extraHeaders status =
-    respondLBS status extraHeaders ""
-
-
-respondJSON :: ToJSON a => ResponseHeaders -> Status -> a -> Application
-respondJSON extraHeaders status =
-    respondLBS status headers . encode
-  where
-    headers = (hContentType, "application/json") : extraHeaders
-
-
-respondText :: ResponseHeaders -> Status -> LT.Text -> Application
-respondText extraHeaders status =
-    respondLBS status headers . LT.encodeUtf8
-  where
-    headers = (hContentType, "text/plain; charset=utf-8") : extraHeaders
-
-
-
-respondLBS :: Status -> ResponseHeaders -> LBS.ByteString -> Application
-respondLBS status headers bs _req respond =
-    respond $ responseLBS status headers bs
-
-
-
--- | HTTP Header names, missing from 'Network.HTTP.Types.Header'.
-
-hAllow :: HeaderName
-hAllow = "Allow"