module Tendermint.SDK.BaseApp.Router.Types
  ( Application
  , RouterError(..)
  , RouteResult(..)
  , RouteResultT(..)
  , HasPath(..)
  ) where

import           Control.Lens                  (Lens')
import           Control.Monad                 (ap)
import           Control.Monad.Trans           (MonadTrans (..))
import           Data.Text                     (Text)
import           Tendermint.SDK.BaseApp.Errors (AppError (..), IsAppError (..))

--------------------------------------------------------------------------------

type Application m req res = req -> m (RouteResult res)

--------------------------------------------------------------------------------

data RouterError =
    PathNotFound
  | ResourceNotFound
  | InvalidRequest Text
  | InternalError Text
  deriving (Int -> RouterError -> ShowS
[RouterError] -> ShowS
RouterError -> String
(Int -> RouterError -> ShowS)
-> (RouterError -> String)
-> ([RouterError] -> ShowS)
-> Show RouterError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouterError] -> ShowS
$cshowList :: [RouterError] -> ShowS
show :: RouterError -> String
$cshow :: RouterError -> String
showsPrec :: Int -> RouterError -> ShowS
$cshowsPrec :: Int -> RouterError -> ShowS
Show)

instance IsAppError RouterError where
  makeAppError :: RouterError -> AppError
makeAppError PathNotFound =
    AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = 1
      , appErrorCodespace :: Text
appErrorCodespace = "router"
      , appErrorMessage :: Text
appErrorMessage = "Path not found."
      }
  makeAppError ResourceNotFound =
    AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = 2
      , appErrorCodespace :: Text
appErrorCodespace = "router"
      , appErrorMessage :: Text
appErrorMessage = "Resource not found."
      }
  makeAppError (InvalidRequest msg :: Text
msg) =
    AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = 3
      , appErrorCodespace :: Text
appErrorCodespace = "router"
      , appErrorMessage :: Text
appErrorMessage = "Invalid request: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
      }
  makeAppError (InternalError _) =
    AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = 4
      , appErrorCodespace :: Text
appErrorCodespace = "router"
      , appErrorMessage :: Text
appErrorMessage = "Internal error."
      }

--------------------------------------------------------------------------------
-- NOTE: most of this was vendored and repurposed from servant.

data RouteResult a =
    Fail RouterError
  | FailFatal RouterError
  | Route a
  deriving (a -> RouteResult b -> RouteResult a
(a -> b) -> RouteResult a -> RouteResult b
(forall a b. (a -> b) -> RouteResult a -> RouteResult b)
-> (forall a b. a -> RouteResult b -> RouteResult a)
-> Functor RouteResult
forall a b. a -> RouteResult b -> RouteResult a
forall a b. (a -> b) -> RouteResult a -> RouteResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RouteResult b -> RouteResult a
$c<$ :: forall a b. a -> RouteResult b -> RouteResult a
fmap :: (a -> b) -> RouteResult a -> RouteResult b
$cfmap :: forall a b. (a -> b) -> RouteResult a -> RouteResult b
Functor)

instance Applicative RouteResult where
  pure :: a -> RouteResult a
pure  = a -> RouteResult a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: RouteResult (a -> b) -> RouteResult a -> RouteResult b
(<*>) = RouteResult (a -> b) -> RouteResult a -> RouteResult b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad RouteResult where
  return :: a -> RouteResult a
return = a -> RouteResult a
forall a. a -> RouteResult a
Route
  >>= :: RouteResult a -> (a -> RouteResult b) -> RouteResult b
(>>=) m :: RouteResult a
m f :: a -> RouteResult b
f = case RouteResult a
m of
    Route     a :: a
a -> a -> RouteResult b
f a
a
    Fail      e :: RouterError
e -> RouterError -> RouteResult b
forall a. RouterError -> RouteResult a
Fail RouterError
e
    FailFatal e :: RouterError
e -> RouterError -> RouteResult b
forall a. RouterError -> RouteResult a
FailFatal RouterError
e

data RouteResultT m a = RouteResultT { RouteResultT m a -> m (RouteResult a)
runRouteResultT :: m (RouteResult a) }
  deriving (a -> RouteResultT m b -> RouteResultT m a
(a -> b) -> RouteResultT m a -> RouteResultT m b
(forall a b. (a -> b) -> RouteResultT m a -> RouteResultT m b)
-> (forall a b. a -> RouteResultT m b -> RouteResultT m a)
-> Functor (RouteResultT m)
forall a b. a -> RouteResultT m b -> RouteResultT m a
forall a b. (a -> b) -> RouteResultT m a -> RouteResultT m b
forall (m :: * -> *) a b.
Functor m =>
a -> RouteResultT m b -> RouteResultT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RouteResultT m a -> RouteResultT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RouteResultT m b -> RouteResultT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RouteResultT m b -> RouteResultT m a
fmap :: (a -> b) -> RouteResultT m a -> RouteResultT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RouteResultT m a -> RouteResultT m b
Functor)

instance MonadTrans RouteResultT where
  lift :: m a -> RouteResultT m a
lift m :: m a
m = m (RouteResult a) -> RouteResultT m a
forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT (m (RouteResult a) -> RouteResultT m a)
-> m (RouteResult a) -> RouteResultT m a
forall a b. (a -> b) -> a -> b
$ (a -> RouteResult a) -> m a -> m (RouteResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> RouteResult a
forall a. a -> RouteResult a
Route m a
m

instance Monad m => Applicative (RouteResultT m) where
  pure :: a -> RouteResultT m a
pure  = a -> RouteResultT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: RouteResultT m (a -> b) -> RouteResultT m a -> RouteResultT m b
(<*>) = RouteResultT m (a -> b) -> RouteResultT m a -> RouteResultT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (RouteResultT m) where
  return :: a -> RouteResultT m a
return = m (RouteResult a) -> RouteResultT m a
forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT (m (RouteResult a) -> RouteResultT m a)
-> (a -> m (RouteResult a)) -> a -> RouteResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteResult a -> m (RouteResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RouteResult a -> m (RouteResult a))
-> (a -> RouteResult a) -> a -> m (RouteResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RouteResult a
forall a. a -> RouteResult a
Route
  >>= :: RouteResultT m a -> (a -> RouteResultT m b) -> RouteResultT m b
(>>=) m :: RouteResultT m a
m f :: a -> RouteResultT m b
f = m (RouteResult b) -> RouteResultT m b
forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT (m (RouteResult b) -> RouteResultT m b)
-> m (RouteResult b) -> RouteResultT m b
forall a b. (a -> b) -> a -> b
$ do
    RouteResult a
a <- RouteResultT m a -> m (RouteResult a)
forall (m :: * -> *) a. RouteResultT m a -> m (RouteResult a)
runRouteResultT RouteResultT m a
m
    case RouteResult a
a of
      Route     a' :: a
a' -> RouteResultT m b -> m (RouteResult b)
forall (m :: * -> *) a. RouteResultT m a -> m (RouteResult a)
runRouteResultT (RouteResultT m b -> m (RouteResult b))
-> RouteResultT m b -> m (RouteResult b)
forall a b. (a -> b) -> a -> b
$ a -> RouteResultT m b
f a
a'
      Fail      e :: RouterError
e  -> RouteResult b -> m (RouteResult b)
forall (m :: * -> *) a. Monad m => a -> m a
return (RouteResult b -> m (RouteResult b))
-> RouteResult b -> m (RouteResult b)
forall a b. (a -> b) -> a -> b
$ RouterError -> RouteResult b
forall a. RouterError -> RouteResult a
Fail RouterError
e
      FailFatal e :: RouterError
e  -> RouteResult b -> m (RouteResult b)
forall (m :: * -> *) a. Monad m => a -> m a
return (RouteResult b -> m (RouteResult b))
-> RouteResult b -> m (RouteResult b)
forall a b. (a -> b) -> a -> b
$ RouterError -> RouteResult b
forall a. RouterError -> RouteResult a
FailFatal RouterError
e

class HasPath t where
  path :: Lens' t Text