rfc 0.0.0.18 → 0.0.0.19
raw patch · 9 files changed
+41/−42 lines, 9 filesdep +lifted-basedep ~classy-prelude
Dependencies added: lifted-base
Dependency ranges changed: classy-prelude
Files
- rfc.cabal +3/−2
- src/RFC/Concurrent.hs +2/−4
- src/RFC/Data/IdAnd.hs +16/−0
- src/RFC/HTTP/Client.hs +3/−4
- src/RFC/JSON.hs +0/−1
- src/RFC/Log.hs +1/−1
- src/RFC/Prelude.hs +5/−21
- src/RFC/Servant/ApiDoc.hs +5/−4
- src/RFC/Wai.hs +6/−5
rfc.cabal view
@@ -1,5 +1,5 @@ name: rfc-version: 0.0.0.18+version: 0.0.0.19 synopsis: Robert Fischer's Common library description: An enhanced Prelude and various utilities for Aeson, Servant, PSQL, and Redis that Robert Fischer uses. homepage: https://github.com/RobertFischer/rfc#README.md@@ -33,7 +33,7 @@ ghc-options: -Werror build-depends: base >= 4.7 && < 5 , servant- , classy-prelude >= 1.4.0+ , classy-prelude >= 1.3 && < 1.4 , uuid-types , containers , unordered-containers@@ -55,6 +55,7 @@ , lifted-async , text , bifunctors+ , lifted-base >= 0.2.3.11 if flag(Browser) build-depends: aeson , attoparsec
src/RFC/Concurrent.hs view
@@ -7,10 +7,8 @@ , module Control.Concurrent.Async.Lifted ) where -import Control.Concurrent.Async.Lifted (mapConcurrently,- mapConcurrently_)-import RFC.Prelude hiding (mapConcurrently,- mapConcurrently_)+import Control.Concurrent.Async.Lifted+import RFC.Prelude hiding (mapConcurrently) -- |Executes all the IO actions simultaneously and returns the original data structure with the arguments replaced -- by the results of the execution.
src/RFC/Data/IdAnd.hs view
@@ -13,11 +13,15 @@ module RFC.Data.IdAnd ( idAndsToMap , IdAnd(..)+ , idAndToId+ , idAndToValue , valuesToIdAnd , idAndToTuple , tupleToIdAnd , idAndToPair , RefMap(..)+ , refMapElems+ , refMapToMap ) where import RFC.Prelude@@ -53,6 +57,18 @@ newtype RefMap a = RefMap (Map.Map UUID (IdAnd a)) deriving (Eq, Ord, Show, Generic, Typeable, FromJSON, ToJSON)++refMapElems :: RefMap a -> [IdAnd a]+refMapElems = Map.elems . refMapToMap++refMapToMap :: RefMap a -> Map.Map UUID (IdAnd a)+refMapToMap (RefMap it) = it++idAndToValue :: IdAnd a -> a+idAndToValue (IdAnd(_,a)) = a++idAndToId :: IdAnd a -> UUID+idAndToId (IdAnd(id,_)) = id tupleToIdAnd :: (UUID, a) -> IdAnd a tupleToIdAnd = IdAnd
src/RFC/HTTP/Client.hs view
@@ -17,7 +17,6 @@ ) where import Control.Lens-import Control.Monad.Catch import Network.HTTP.Client (Manager, ManagerSettings, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings)@@ -26,7 +25,7 @@ import Network.Wreq.Lens import Network.Wreq.Session hiding (withAPISession) import RFC.JSON (FromJSON, decodeOrDie)-import RFC.Prelude hiding (handle)+import RFC.Prelude import RFC.String rfcManagerSettings :: ManagerSettings@@ -42,7 +41,7 @@ deriving (Show,Eq,Ord,Generic,Typeable) instance Exception BadStatusException -apiExecute :: (HasAPIClient m, MonadIO m, ConvertibleString LazyByteString s) =>+apiExecute :: (MonadThrow m, HasAPIClient m, MonadIO m, ConvertibleString LazyByteString s) => URL -> (Session -> String -> IO (Response LazyByteString)) -> (s -> m a) -> m a apiExecute rawUrl action converter = do session <- getAPIClient@@ -50,7 +49,7 @@ let status = response ^. responseStatus case status ^. statusCode of 200 -> converter . cs $ response ^. responseBody- _ -> throwIO $ badResponseStatus status+ _ -> throwM $ badResponseStatus status where url = exportURL rawUrl badResponseStatus status = BadStatusException (status, rawUrl)
src/RFC/JSON.hs view
@@ -19,7 +19,6 @@ ) where import ClassyPrelude-import Control.Monad.Catch import Data.Aeson as JSON import Data.Aeson.Parser as JSONParser import Data.Aeson.TH (deriveJSON)
src/RFC/Log.hs view
@@ -11,7 +11,7 @@ import Control.Logger.Simple as Log import RFC.Env as Env import RFC.Prelude-import System.IO (BufferMode (..), stderr)+import System.IO (BufferMode (..), hSetBuffering, stderr) withLogging :: IO a -> IO a withLogging action = do
src/RFC/Prelude.hs view
@@ -1,6 +1,5 @@ module RFC.Prelude- ( module ClassyPrelude- , module RFC.Prelude+ ( module RFC.Prelude , module RFC.Data.UUID , module Data.String.Conversions , module GHC.Generics@@ -14,18 +13,13 @@ , module Data.Bifoldable , module Data.Default , module Control.Monad.Trans.Control- , module Control.Monad.Catch+ , module Control.Concurrent.Lifted+ , module ClassyPrelude ) where -import ClassyPrelude hiding (Day, Handler, bracket,- bracketOnError, bracket_, catch,- catchJust, catches, finally,- handle, handleJust, mask, mask_,- onException, try, tryJust,- uninterruptibleMask,- uninterruptibleMask_, unpack)+import ClassyPrelude hiding (Day, unpack)+import Control.Concurrent.Lifted hiding (throwTo) import Control.Monad (forever, void, (<=<), (>=>))-import Control.Monad.Catch import Control.Monad.Trans.Control import Data.Bifoldable import Data.Bifunctor@@ -39,7 +33,6 @@ import Data.Time.Units import Data.Typeable (TypeRep, typeOf) import GHC.Generics (Generic)-import Prelude () import RFC.Data.UUID (UUID) import Text.Read (Read, read) @@ -52,17 +45,8 @@ uniq :: (Eq a) => [a] -> [a] uniq = List.nub -mapFst :: (a -> c) -> (a,b) -> (c,b)-mapFst f (a,b) = (f a, b)--mapSnd :: (b -> c) -> (a,b) -> (a,c)-mapSnd f (a,b) = (a, f b)- safeHead :: [a] -> Maybe a safeHead [] = Nothing safeHead (x:_) = Just x--throw :: (MonadThrow m, Exception e) => e -> m a-throw = throwM type Boolean = Bool -- I keep forgetting which Haskell uses....
src/RFC/Servant/ApiDoc.hs view
@@ -14,10 +14,11 @@ import qualified Data.Binary.Builder as Builder import Data.Char as Char import Data.Default (def)+import Data.Monoid ((<>)) import Network.HTTP.Types.Header (hContentType) import Network.HTTP.Types.Status import Network.Wai-import RFC.Prelude+import RFC.Prelude hiding ((<>)) import RFC.Servant import RFC.String import Servant.Swagger@@ -38,8 +39,8 @@ apiToSwagger :: (HasSwagger a) => Proxy a -> Swagger apiToSwagger = toSwagger -apiApplication :: (HasDocs a, HasSwagger a) => Proxy a -> Application-apiApplication api request callback =+apiApplication :: (HasDocs a, HasSwagger a) => Proxy a -> Swagger -> Application+apiApplication api addlSwagger request callback = case reqMethod of "GET" -> checkPath _ -> failMethodNotAllowed@@ -49,7 +50,7 @@ ascii = apiToAscii api swaggerToLbs :: Swagger -> LazyByteString swaggerToLbs = Builder.toLazyByteString . fromEncoding . toEncoding- swagger = swaggerToLbs $ apiToSwagger api+ swagger = swaggerToLbs $ apiToSwagger api <> addlSwagger reqMethod :: String reqMethod = map Char.toUpper $ cs $ requestMethod request pathInfo :: String
src/RFC/Wai.hs view
@@ -2,23 +2,24 @@ module RFC.Wai ( defaultMiddleware+ , module Network.Wai ) where import Network.HTTP.Types.Header import Network.HTTP.Types.Method import Network.Wai import Network.Wai.Middleware.AcceptOverride-import Network.Wai.Middleware.Approot (envFallback)+import Network.Wai.Middleware.Approot ( envFallback ) import Network.Wai.Middleware.Autohead import Network.Wai.Middleware.Cors import Network.Wai.Middleware.Gzip import Network.Wai.Middleware.Jsonp import Network.Wai.Middleware.MethodOverridePost-import Network.Wai.Middleware.RequestLogger (logStdout,- logStdoutDev)-import RFC.Env (isDevelopment)+import Network.Wai.Middleware.RequestLogger ( logStdout, logStdoutDev )+import RFC.Env ( isDevelopment ) import RFC.Prelude-import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory)+import System.IO.Temp+ ( createTempDirectory, getCanonicalTemporaryDirectory ) defaultMiddleware :: IO Middleware defaultMiddleware = do