module Yu.Utils.Handler
(
catchH
, handlerH
, tryH
,
(<#>)
, (<%>)
,
returnE
, returnET
, returnEH
,
showJs
, fromBinToBytestr
, LogPath(..)
) where
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson
import Data.Either
import Database.MongoDB
import Text.Julius (RawJavascript, rawJS)
import Yesod.Core
import qualified Yu.Import.ByteString as B
import qualified Yu.Import.Text as T
catchH :: Exception e
=> HandlerT site IO a
-> (e -> HandlerT site IO a)
-> HandlerT site IO a
catchH m h = handlerToIO >>=
(\hio -> liftIO $ catch (hio m) (hio.h))
handlerH :: Exception e
=> (e -> HandlerT site IO a)
-> HandlerT site IO a
-> HandlerT site IO a
handlerH = flip catchH
tryH :: Exception e
=> HandlerT site IO a
-> HandlerT site IO (Either e a)
tryH m = handlerToIO >>= (\hio -> liftIO . try $ hio m)
infixl 4 <#>, <%>
(<#>) :: (Functor f1,Functor f2)
=> (a -> b)
-> f1 (f2 a)
-> f1 (f2 b)
(<#>) f = ((f <$>) <$>)
(<%>) :: (Monad m, Functor f)
=> (a -> m b)
-> f (m a)
-> f (m b)
(<%>) f = ((f =<<) <$>)
returnE :: (Monad m,Exception e)
=> e
-> m String
returnE = pure . (\str -> "{\"error\":\"exception\",\"context\":\"" ++ str ++ "\"}") . show
returnET :: (Monad m,Exception e)
=> e
-> m T.Text
returnET = (fmap T.pack) . returnE
returnEH :: SomeException
-> HandlerT site IO TypedContent
returnEH e = returnE e >>=
(\str -> respondSource "application/json" $ do
sendChunk str
sendFlush
)
showJs :: Show a => a -> RawJavascript
showJs = rawJS . T.show
fromBinToBytestr :: Binary -> B.ByteString
fromBinToBytestr (Binary x) = x
data LogPath = LogFile FilePath
| LogStdout
| LogStderr
instance FromJSON LogPath where
parseJSON (Yesod.Core.String v) = pure $ case T.toLower v of
"stdout" -> LogStdout
"stderr" -> LogStderr
_ -> LogFile $ T.unpack v
instance ToJSON ErrorResponse where
toJSON NotFound =
object ["error" .= ("not found" ::String)]
toJSON (InternalError e) =
object [ "error" .= ("internal error"::String)
, "content" .= e
]
toJSON (InvalidArgs es) =
object [ "error" .= ("invalid args"::String)
, "content" .= es
]
toJSON NotAuthenticated =
object ["error" .= ("not authenticated!"::String)]
toJSON (PermissionDenied msg) =
object [ "error" .= ("permission denied"::String)
, "content" .= msg
]
toJSON (BadMethod m) =
object [ "error" .= ("bad method" :: String)
, "content" .= show m
]