module Control.Monad.Apiary.Filter.Capture where
import Network.Wai
import Control.Applicative
import qualified Data.Text as T
import Data.Apiary.Param
import Data.Apiary.SList
import Control.Monad.Apiary
data Equal = Equal T.Text
data Fetch a = Fetch
class CaptureElem a where
type Next a (xs :: [*]) :: [*]
captureElem :: a -> T.Text -> SList xs -> Maybe (SList (Next a xs))
instance CaptureElem Equal where
type Next Equal xs = xs
captureElem (Equal s) p c | s == p = Just c
| otherwise = Nothing
instance Param a => CaptureElem (Fetch a) where
type Next (Fetch a) xs = (xs `Snoc` a)
captureElem (Fetch :: Fetch a) p c = (sSnoc c) <$> (readParam p :: Maybe a)
type Capture as = All CaptureElem as
type family CaptureResult (bf :: [*]) (as :: [*]) :: [*]
type instance CaptureResult bf '[] = bf
type instance CaptureResult bf (a ': as) = (CaptureResult (Next a bf) as)
capture' :: Capture as => SList as -> [T.Text] -> SList xs -> Maybe (SList (CaptureResult xs as))
capture' SNil [] bf = Just bf
capture' (c ::: cs) (p:ps) bf = captureElem c p bf >>= capture' cs ps
capture' SNil _ _ = Nothing
capture' _ [] _ = Nothing
capture :: (Capture as, Monad m) => SList as -> ApiaryT (CaptureResult xs as) m b -> ApiaryT xs m b
capture cap = function $ \bf req -> capture' cap (pathInfo req) bf