{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Linnet.Endpoints.Paths
( path
, pathConst
, p'
, pathEmpty
, paths
, pathAny
) where
import Data.Data (Proxy (..), Typeable, typeRep)
import Data.Maybe (maybeToList)
import qualified Data.Text as T
import Linnet.Decode
import Linnet.Endpoint
import Linnet.Input
import Linnet.Internal.HList
import Linnet.Output (ok)
path ::
forall a m. (DecodePath a, Applicative m, Typeable a)
=> Endpoint m a
path =
Endpoint
{ runEndpoint =
\input ->
case reminder input of
[] -> NotMatched
(h:t) ->
case decodePath h of
Just v -> Matched {matchedReminder = input {reminder = t}, matchedOutput = pure $ ok v}
Nothing -> NotMatched
, toString = show (typeRep (Proxy :: Proxy a))
}
pathConst :: (Applicative m) => T.Text -> Endpoint m (HList '[])
pathConst value =
Endpoint
{ runEndpoint =
\input ->
case reminder input of
[] -> NotMatched
(h:t) ->
if h == value
then Matched {matchedReminder = input {reminder = t}, matchedOutput = pure $ ok HNil}
else NotMatched
, toString = T.unpack value
}
p' :: (Applicative m) => T.Text -> Endpoint m (HList '[])
p' = pathConst
pathEmpty :: Applicative m => Endpoint m (HList '[])
pathEmpty =
Endpoint
{ runEndpoint =
\input ->
case reminder input of
[] -> Matched input (pure . ok $ HNil)
_ -> NotMatched
, toString = "/"
}
paths ::
forall a m. (DecodePath a, Applicative m, Typeable a)
=> Endpoint m [a]
paths =
Endpoint
{ runEndpoint =
\input ->
Matched
{ matchedReminder = input {reminder = []}
, matchedOutput = pure $ ok (map (decodePath @a) (reminder input) >>= maybeToList)
}
, toString = "[" ++ show (typeRep (Proxy :: Proxy a)) ++ "]"
}
pathAny :: (Applicative m) => Endpoint m (HList '[])
pathAny =
Endpoint
{ runEndpoint = \input -> Matched {matchedReminder = input {reminder = []}, matchedOutput = pure . ok $ HNil}
, toString = "*"
}