{-# LANGUAGE OverloadedStrings #-}

module Web.Scotty.Utils
  ( maybeNotFound
  , eitherNotFound
  , eitherBadRequest
  , err
  , ok
  , errNotFound
  , errBadRequest
  , okListResult
  , safeParam
  ) where

import           Network.HTTP.Types (Status, status400, status404)
import           Web.Scotty.Trans   (ActionT, Parsable, ScottyError, json,
                                     param, rescue, status)

import qualified Data.Aeson.Result  as R (Err, List, err, fromList, fromOk, ok)

import           Data.Aeson         (ToJSON)
import           Data.Aeson.Key     (Key)
import qualified Data.Text.Lazy     as LT (Text)

maybeNotFound :: (ToJSON a, ScottyError e, Monad m) => String -> Maybe a -> ActionT e m ()
maybeNotFound :: String -> Maybe a -> ActionT e m ()
maybeNotFound String
_ (Just a
a)  = a -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json a
a
maybeNotFound String
obj Maybe a
Nothing = Status -> String -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Status -> String -> ActionT e m ()
err Status
status404 (String -> ActionT e m ()) -> String -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ String
obj String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found."

eitherBadRequest :: (ToJSON a, ScottyError e, Monad m) => Either R.Err a -> ActionT e m ()
eitherBadRequest :: Either Err a -> ActionT e m ()
eitherBadRequest (Right a
a) = a -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json a
a
eitherBadRequest (Left Err
e)  = Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status400 ActionT e m () -> ActionT e m () -> ActionT e m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Err -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json Err
e

eitherNotFound :: (ToJSON a, ScottyError e, Monad m) => Either R.Err a -> ActionT e m ()
eitherNotFound :: Either Err a -> ActionT e m ()
eitherNotFound (Right a
a) = a -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json a
a
eitherNotFound (Left Err
e)  = Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status404 ActionT e m () -> ActionT e m () -> ActionT e m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Err -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json Err
e

err :: (ScottyError e, Monad m) => Status -> String -> ActionT e m ()
err :: Status -> String -> ActionT e m ()
err Status
st String
msg = Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
st ActionT e m () -> ActionT e m () -> ActionT e m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Err -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json (String -> Err
R.err String
msg)

ok :: (ToJSON a, ScottyError e, Monad m) => Key -> a -> ActionT e m ()
ok :: Key -> a -> ActionT e m ()
ok Key
key = Value -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json (Value -> ActionT e m ()) -> (a -> Value) -> a -> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Ok a -> Value
forall a. ToJSON a => Key -> Ok a -> Value
R.fromOk Key
key (Ok a -> Value) -> (a -> Ok a) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ok a
forall a. a -> Ok a
R.ok

errNotFound :: (ScottyError e, Monad m) => String -> ActionT e m ()
errNotFound :: String -> ActionT e m ()
errNotFound = Status -> String -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Status -> String -> ActionT e m ()
err Status
status404

errBadRequest :: (ScottyError e, Monad m) => String -> ActionT e m ()
errBadRequest :: String -> ActionT e m ()
errBadRequest = Status -> String -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Status -> String -> ActionT e m ()
err Status
status400

okListResult :: (ToJSON a, ScottyError e, Monad m) => Key -> R.List a -> ActionT e m ()
okListResult :: Key -> List a -> ActionT e m ()
okListResult Key
key = Value -> ActionT e m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
json (Value -> ActionT e m ())
-> (List a -> Value) -> List a -> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> List a -> Value
forall a. ToJSON a => Key -> List a -> Value
R.fromList Key
key

safeParam ::(Parsable a, ScottyError e, Monad m) => LT.Text -> a -> ActionT e m a
safeParam :: Text -> a -> ActionT e m a
safeParam Text
key a
def = Text -> ActionT e m a
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param Text
key ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`rescue` (\e
_ -> a -> ActionT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def)