{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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)
import Network.Wai (pathInfo)
path ::
forall a m. (DecodePath a, Applicative m, Typeable a)
=> Endpoint m a
path =
Endpoint
{ runEndpoint =
\input ->
case reminder input of
[] -> NotMatched Other
(h:t) ->
case decodePath h of
Just v ->
Matched {matchedReminder = input {reminder = t}, matchedTrace = [str], matchedOutput = pure $ ok v}
Nothing -> NotMatched Other
, toString = str
}
where
str = T.pack $ show (typeRep (Proxy :: Proxy a))
pathConst :: (Applicative m) => T.Text -> Endpoint m (HList '[])
pathConst value =
Endpoint
{ runEndpoint =
\input ->
case reminder input of
[] -> NotMatched Other
(h:t) ->
if h == value
then Matched
{matchedReminder = input {reminder = t}, matchedTrace = [h], matchedOutput = pure $ ok HNil}
else NotMatched Other
, toString = 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 {matchedReminder = input, matchedTrace = [], matchedOutput = pure . ok $ HNil}
_ -> NotMatched Other
, toString = "/"
}
paths ::
forall a m. (DecodePath a, Applicative m, Typeable a)
=> Endpoint m [a]
paths =
Endpoint
{ runEndpoint =
\input@Input {..} ->
Matched
{ matchedReminder = input {reminder = []}
, matchedTrace = pathInfo request
, matchedOutput = pure $ ok (map (decodePath @a) reminder >>= maybeToList)
}
, toString = "[" `T.append` T.pack (show $ typeRep (Proxy :: Proxy a)) `T.append` "]"
}
pathAny :: (Applicative m) => Endpoint m (HList '[])
pathAny =
Endpoint
{ runEndpoint =
\input@Input {..} ->
Matched
{matchedReminder = input {reminder = []}, matchedTrace = pathInfo request, matchedOutput = pure . ok $ HNil}
, toString = "*"
}