
  0 | module TyTTP.URL.Search
  1 | 
  2 | import Control.Monad.Either
  3 | import Data.List
  4 | import Data.List1
  5 | import Data.Maybe
  6 | import TyTTP
  7 | import TyTTP.URL.Definition
  8 | 
  9 | %default total
 10 | 
 11 | namespace Simple
 12 | 
 13 |   public export
 14 |   SimpleSearch : Type
 15 |   SimpleSearch = List (String, String)
 16 | 
 17 |   parseString : String -> SimpleSearch
 18 |   parseString = parseSkipQuestionMarks . unpack
 19 |     where
 20 |       parse : List Char -> SimpleSearch
 21 |       parse [] = []
 22 |       parse xs =
 23 |         let sections = splitOn '&' xs
 24 |             params = break (== '=') <$> List.filter (not . null) (forget sections)
 25 |         in 
 26 |           bimap pack (pack . fromMaybe [] . tail') <$> params
 27 | 
 28 |       parseSkipQuestionMarks : List Char -> SimpleSearch
 29 |       parseSkipQuestionMarks [] = []
 30 |       parseSkipQuestionMarks ('?'::xs) = parseSkipQuestionMarks xs
 31 |       parseSkipQuestionMarks a@(x::xs) = parse a
 32 | 
 33 | 
 34 |   export
 35 |   search : Monad m
 36 |     => (
 37 |       Context me (URL auth pth SimpleSearch) v h1 st h2 a b
 38 |       -> m $ Context me' (URL auth pth SimpleSearch) v' h1' st' h2' a' b'
 39 |     )
 40 |     -> Context me (URL auth pth String) v h1 st h2 a b
 41 |     -> m $ Context me' (URL auth pth String) v' h1' st' h2' a' b'
 42 |   search handler ctx = do
 43 |     let src = parseString $ URL.search ctx.request.url
 44 |     result <- handler $ { request.url := { search := src } ctx.request.url } ctx
 45 |     pure $ { request.url := { search := ctx.request.url.search } result.request.url } result
 46 | 
 47 |