Make postgrest usable as a library

src/PostgREST/App.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
-module App (app, sqlError, isSqlError) where
+module PostgREST.App (app, sqlError, isSqlError) where
 
 import Control.Monad (join)
 import Control.Arrow ((***), second)
@@ -34,11 +34,11 @@ import qualified Hasql as H
 import qualified Hasql.Backend as B
 import qualified Hasql.Postgres as P
 
-import Config (AppConfig(..))
-import Auth
-import PgQuery
-import RangeQuery
-import PgStructure
+import PostgREST.Config (AppConfig(..))
+import PostgREST.Auth
+import PostgREST.PgQuery
+import PostgREST.RangeQuery
+import PostgREST.PgStructure
 
 import Prelude
 
@@ -105,13 +105,13 @@ app conf reqBody req =
             , (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
             ] ""
 
-    (["postgrest", "tokens"], "POST") -> 
+    (["postgrest", "tokens"], "POST") ->
       case jwtSecret of
         "secret" -> return $ responseLBS status500 [jsonH] $
           encode . object $ [("message", String "JWT Secret is set as \"secret\" which is an unsafe default.")]
         _ -> do
           let user = decode reqBody :: Maybe AuthUser
-          
+
           case user of
             Nothing -> return $ responseLBS status400 [jsonH] $
               encode . object $ [("message", String "Failed to parse user.")]
@@ -120,7 +120,7 @@ app conf reqBody req =
               login <- signInRole (cs $ userId u)
                               (cs $ userPass u)
               case login of
-                LoginSuccess role -> 
+                LoginSuccess role ->
                   return $ responseLBS status201 [ jsonH ] $
                     encode . object $ [("token", String $ tokenJWT jwtSecret (cs $ userId u) role)]
                 _  -> return $ responseLBS status401 [jsonH] $

src/PostgREST/Auth.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
-module Auth where
+module PostgREST.Auth where
 
 import Data.Aeson
 import Control.Monad (mzero)
@@ -14,7 +14,7 @@ import qualified Hasql.Backend as B
 import qualified Hasql.Postgres as P
 import qualified Web.JWT as JWT
 import Data.String.Conversions (cs)
-import PgQuery (pgFmtLit)
+import PostgREST.PgQuery (pgFmtLit)
 
 import Prelude
 

src/PostgREST/Config.hs

@@ -1,4 +1,4 @@
-module Config where
+module PostgREST.Config where
 
 import Network.Wai
 import Control.Applicative

src/PostgREST/Error.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
 
-module Error (PgError, errResponse) where
+module PostgREST.Error (PgError, errResponse) where
 
 import qualified Hasql as H
 import qualified Hasql.Postgres as P

src/PostgREST/Main.hs

@@ -2,9 +2,9 @@ module Main where
 
 import Paths_postgrest (version)
 
-import App
-import Middleware
-import Error(errResponse)
+import PostgREST.App
+import PostgREST.Middleware
+import PostgREST.Error(errResponse)
 
 import Control.Monad (unless)
 import Control.Monad.IO.Class (liftIO)
@@ -21,7 +21,7 @@ import qualified Hasql as H
 import qualified Hasql.Postgres as P
 import Options.Applicative hiding (columns)
 
-import Config (AppConfig(..), argParser, corsPolicy)
+import PostgREST.Config (AppConfig(..), argParser, corsPolicy)
 
 main :: IO ()
 main = do

src/PostgREST/Middleware.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Middleware where
+module PostgREST.Middleware where
 
 import Data.Maybe (fromMaybe)
 import Data.Monoid
@@ -19,8 +19,8 @@ import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
                    rawQueryString, isSecure, Request(..), Response)
 import Network.URI (URI(..), parseURI)
 
-import Config (AppConfig(..))
-import Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, resetRole)
+import PostgREST.Config (AppConfig(..))
+import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, resetRole)
 import Codec.Binary.Base64.String (decode)
 
 import Prelude

src/PostgREST/PgQuery.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiWayIf #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module PgQuery where
+module PostgREST.PgQuery where
 
-import RangeQuery
+import PostgREST.RangeQuery
 
 import qualified Hasql as H
 import qualified Hasql.Postgres as P

src/PostgREST/PgStructure.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
              MultiParamTypeClasses, ScopedTypeVariables,
              FlexibleContexts #-}
-module PgStructure where
+module PostgREST.PgStructure where
 
-import PgQuery (QualifiedTable(..))
+import PostgREST.PgQuery (QualifiedTable(..))
 import Data.Text hiding (foldl, map, zipWith, concat)
 import Data.Aeson
 import Data.Functor.Identity

src/PostgREST/RangeQuery.hs

@@ -1,4 +1,4 @@
-module RangeQuery (
+module PostgREST.RangeQuery (
   rangeParse
 , rangeRequested
 , rangeLimit

src/Types.hs

@@ -1,57 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Types where
-
-import qualified Data.Aeson as JSON
-import Data.Aeson.Types (Parser)
-
-import Data.Scientific (floatingOrInteger)
-import Data.HashMap.Strict (foldlWithKey')
-import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8)
-import Data.Time.Calendar (showGregorian)
-import Control.Monad (mzero)
-
-instance JSON.FromJSON SqlValue where
-  parseJSON (JSON.Number n)    = return $ either toSql iToSql (floatingOrInteger n :: Either Double Int)
-  parseJSON (JSON.String s)    = return $ toSql s
-  parseJSON (JSON.Bool   b)    = return $ toSql b
-  parseJSON JSON.Null          = return SqlNull
-  parseJSON (JSON.Object o)    = return . toSql $ JSON.encode o
-  parseJSON (JSON.Array  a)    = return . toSql $ JSON.encode a
-
-instance JSON.ToJSON SqlValue where
-  toJSON (SqlString s)         = JSON.toJSON s
-  toJSON (SqlByteString s)     = JSON.toJSON $ decodeUtf8 s
-  toJSON (SqlWord32 w)         = JSON.toJSON w
-  toJSON (SqlWord64 w)         = JSON.toJSON w
-  toJSON (SqlInt32 i)          = JSON.toJSON i
-  toJSON (SqlInt64 i)          = JSON.toJSON i
-  toJSON (SqlInteger i)        = JSON.toJSON i
-  toJSON (SqlChar c)           = JSON.toJSON c
-  toJSON (SqlBool b)           = JSON.toJSON b
-  toJSON (SqlDouble n)         = JSON.toJSON n
-  toJSON (SqlRational n)       = JSON.toJSON n
-  toJSON (SqlLocalDate d)      = JSON.toJSON $ showGregorian d
-  toJSON (SqlLocalTimeOfDay t) = JSON.toJSON $ show t
-  toJSON (SqlLocalTime t)      = JSON.toJSON $ show t
-  toJSON SqlNull               = JSON.Null
-  toJSON x                     = JSON.toJSON $ show x
-
-
-newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] } deriving (Show)
-
-sqlRowColumns :: SqlRow -> [Text]
-sqlRowColumns = map fst . getRow
-
-sqlRowValues :: SqlRow -> [SqlValue]
-sqlRowValues = map snd . getRow
-
-instance JSON.FromJSON SqlRow where
-  parseJSON (JSON.Object m) = foldlWithKey' add (return $ SqlRow []) m
-    where
-      add :: Parser SqlRow -> Text -> JSON.Value -> Parser SqlRow
-      add parser k v = do
-        SqlRow l <- parser
-        sqlV <- JSON.parseJSON v
-        return . SqlRow $ (k, sqlV) : l
-  parseJSON _ = mzero