Paths.hs

{-# 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)

-- | Endpoint that tries to decode head of the current path reminder into specific type. It consumes head of the reminder.
--
-- * If path is empty, Endpoint is not matched
--
-- * If decoding has failed, Endpoint is not matched
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}, matchedOutput = pure $ ok v}
                Nothing -> NotMatched Other
    , toString = show (typeRep (Proxy :: Proxy a))
    }

-- | Endpoint that matches only if the head of current path reminder is equal to some given constant value.
-- It consumes head of the reminder.
--
-- * If value matches the provided constant, saves the tail of the path as a reminder
--
-- * Otherwise, resulting endpoint is not matched
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}, matchedOutput = pure $ ok HNil}
                else NotMatched Other
    , toString = T.unpack value
    }

-- | Short alias for pathConst
p' :: (Applicative m) => T.Text -> Endpoint m (HList '[])
p' = pathConst

-- | Endpoint that matches only against empty path reminder
pathEmpty :: Applicative m => Endpoint m (HList '[])
pathEmpty =
  Endpoint
    { runEndpoint =
        \input ->
          case reminder input of
            [] -> Matched input (pure . ok $ HNil)
            _  -> NotMatched Other
    , toString = "/"
    }

-- | Endpoint that consumes the rest of the path reminder and decode it using provided DecodePath for some type @a@
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)) ++ "]"
    }

-- | Endpoint that matches any path and discards reminder
pathAny :: (Applicative m) => Endpoint m (HList '[])
pathAny =
  Endpoint
    { runEndpoint = \input -> Matched {matchedReminder = input {reminder = []}, matchedOutput = pure . ok $ HNil}
    , toString = "*"
    }