{-# OPTIONS_GHC -Wno-orphans #-}

-- | Server implementation of the path traits.
module WebGear.Server.Trait.Path where

import qualified Data.List as List
import qualified Data.Text as Text
import Web.HttpApiData (FromHttpApiData (..))
import WebGear.Core.Handler (RoutePath (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Trait (Get (..), Linked)
import WebGear.Core.Trait.Path (Path (..), PathEnd (..), PathVar (..), PathVarError (..))
import WebGear.Server.Handler (ServerHandler (..))

instance Monad m => Get (ServerHandler m) Path Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: Path -> ServerHandler m (Linked ts Request) (Either () ())
  getTrait :: Path -> ServerHandler m (Linked ts Request) (Either () ())
getTrait (Path Text
p) = ((Linked ts Request, RoutePath)
 -> m (Either RouteMismatch (Either () ()), RoutePath))
-> ServerHandler m (Linked ts Request) (Either () ())
forall (m :: * -> *) a b.
((a, RoutePath) -> m (Either RouteMismatch b, RoutePath))
-> ServerHandler m a b
ServerHandler (((Linked ts Request, RoutePath)
  -> m (Either RouteMismatch (Either () ()), RoutePath))
 -> ServerHandler m (Linked ts Request) (Either () ()))
-> ((Linked ts Request, RoutePath)
    -> m (Either RouteMismatch (Either () ()), RoutePath))
-> ServerHandler m (Linked ts Request) (Either () ())
forall a b. (a -> b) -> a -> b
$ \(Linked ts Request
_, path :: RoutePath
path@(RoutePath [Text]
remaining)) -> do
    let expected :: [Text]
expected = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Text.splitOn Text
"/" Text
p
    (Either RouteMismatch (Either () ()), RoutePath)
-> m (Either RouteMismatch (Either () ()), RoutePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Either RouteMismatch (Either () ()), RoutePath)
 -> m (Either RouteMismatch (Either () ()), RoutePath))
-> (Either RouteMismatch (Either () ()), RoutePath)
-> m (Either RouteMismatch (Either () ()), RoutePath)
forall a b. (a -> b) -> a -> b
$ case [Text] -> [Text] -> Maybe [Text]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [Text]
expected [Text]
remaining of
      Just [Text]
ps -> (Either () () -> Either RouteMismatch (Either () ())
forall a b. b -> Either a b
Right (() -> Either () ()
forall a b. b -> Either a b
Right ()), [Text] -> RoutePath
RoutePath [Text]
ps)
      Maybe [Text]
Nothing -> (Either () () -> Either RouteMismatch (Either () ())
forall a b. b -> Either a b
Right (() -> Either () ()
forall a b. a -> Either a b
Left ()), RoutePath
path)

instance (Monad m, FromHttpApiData val) => Get (ServerHandler m) (PathVar tag val) Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: PathVar tag val -> ServerHandler m (Linked ts Request) (Either PathVarError val)
  getTrait :: PathVar tag val
-> ServerHandler m (Linked ts Request) (Either PathVarError val)
getTrait PathVar tag val
PathVar = ((Linked ts Request, RoutePath)
 -> m (Either RouteMismatch (Either PathVarError val), RoutePath))
-> ServerHandler m (Linked ts Request) (Either PathVarError val)
forall (m :: * -> *) a b.
((a, RoutePath) -> m (Either RouteMismatch b, RoutePath))
-> ServerHandler m a b
ServerHandler (((Linked ts Request, RoutePath)
  -> m (Either RouteMismatch (Either PathVarError val), RoutePath))
 -> ServerHandler m (Linked ts Request) (Either PathVarError val))
-> ((Linked ts Request, RoutePath)
    -> m (Either RouteMismatch (Either PathVarError val), RoutePath))
-> ServerHandler m (Linked ts Request) (Either PathVarError val)
forall a b. (a -> b) -> a -> b
$ \(Linked ts Request
_, path :: RoutePath
path@(RoutePath [Text]
remaining)) -> do
    (Either RouteMismatch (Either PathVarError val), RoutePath)
-> m (Either RouteMismatch (Either PathVarError val), RoutePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Either RouteMismatch (Either PathVarError val), RoutePath)
 -> m (Either RouteMismatch (Either PathVarError val), RoutePath))
-> (Either RouteMismatch (Either PathVarError val), RoutePath)
-> m (Either RouteMismatch (Either PathVarError val), RoutePath)
forall a b. (a -> b) -> a -> b
$ case [Text]
remaining of
      [] -> (Either PathVarError val
-> Either RouteMismatch (Either PathVarError val)
forall a b. b -> Either a b
Right (PathVarError -> Either PathVarError val
forall a b. a -> Either a b
Left PathVarError
PathVarNotFound), RoutePath
path)
      (Text
p : [Text]
ps) ->
        case Text -> Either Text val
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece Text
p of
          Left Text
e -> (Either PathVarError val
-> Either RouteMismatch (Either PathVarError val)
forall a b. b -> Either a b
Right (PathVarError -> Either PathVarError val
forall a b. a -> Either a b
Left (PathVarError -> Either PathVarError val)
-> PathVarError -> Either PathVarError val
forall a b. (a -> b) -> a -> b
$ Text -> PathVarError
PathVarParseError Text
e), RoutePath
path)
          Right val
val -> (Either PathVarError val
-> Either RouteMismatch (Either PathVarError val)
forall a b. b -> Either a b
Right (val -> Either PathVarError val
forall a b. b -> Either a b
Right val
val), [Text] -> RoutePath
RoutePath [Text]
ps)

instance Monad m => Get (ServerHandler m) PathEnd Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: PathEnd -> ServerHandler m (Linked ts Request) (Either () ())
  getTrait :: PathEnd -> ServerHandler m (Linked ts Request) (Either () ())
getTrait PathEnd
PathEnd = ((Linked ts Request, RoutePath)
 -> m (Either RouteMismatch (Either () ()), RoutePath))
-> ServerHandler m (Linked ts Request) (Either () ())
forall (m :: * -> *) a b.
((a, RoutePath) -> m (Either RouteMismatch b, RoutePath))
-> ServerHandler m a b
ServerHandler (Linked ts Request, RoutePath)
-> m (Either RouteMismatch (Either () ()), RoutePath)
forall (f :: * -> *) a a.
Applicative f =>
(a, RoutePath) -> f (Either a (Either () ()), RoutePath)
f
    where
      f :: (a, RoutePath) -> f (Either a (Either () ()), RoutePath)
f (a
_, p :: RoutePath
p@(RoutePath [])) = (Either a (Either () ()), RoutePath)
-> f (Either a (Either () ()), RoutePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either () () -> Either a (Either () ())
forall a b. b -> Either a b
Right (Either () () -> Either a (Either () ()))
-> Either () () -> Either a (Either () ())
forall a b. (a -> b) -> a -> b
$ () -> Either () ()
forall a b. b -> Either a b
Right (), RoutePath
p)
      f (a
_, RoutePath
p) = (Either a (Either () ()), RoutePath)
-> f (Either a (Either () ()), RoutePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either () () -> Either a (Either () ())
forall a b. b -> Either a b
Right (Either () () -> Either a (Either () ()))
-> Either () () -> Either a (Either () ())
forall a b. (a -> b) -> a -> b
$ () -> Either () ()
forall a b. a -> Either a b
Left (), RoutePath
p)