
   0 | module Network.URL.HTTP.Parser
   1 | 
   2 | import Text.Lexer
   3 | import Text.Parser
   4 | 
   5 | 
   6 | import Data.List1
   7 | import Data.List
   8 | import Data.String
   9 | import Data.Maybe
  10 | 
  11 | import Network.URL.HTTP.Data
  12 | import Network.URL.Internal.StringParser
  13 | import Network.URL.Internal.Predicate
  14 | import Data.String.Parser
  15 | 
  16 | private
  17 | validaId : Char -> Bool
  18 | validaId = anyPass [isAlphaNum, (== '+'), (== '-'), (== '.')]
  19 | 
  20 | private 
  21 | parserScheme : Parser String
  22 | parserScheme = do
  23 |   schemeHead <- letter
  24 |   schemeTail <- takeWhile validaId
  25 |   token ":"
  26 |   pure $ singleton schemeHead ++ schemeTail
  27 | 
  28 | private
  29 | parserHost : Parser String
  30 | parserHost = do
  31 |   token "//"
  32 |   takeWhile1 validaId
  33 | 
  34 | ||| 验证端口号是否在有效范围内 (0-65535)
  35 | private
  36 | validatePort : Int -> Maybe Int
  37 | validatePort p = if p >= 0 && p <= 65535 then Just p else Nothing
  38 | 
  39 | private
  40 | parserPort : Parser Int
  41 | parserPort = do
  42 |   token ":"
  43 |   p <- int
  44 |   case validatePort p of
  45 |     Just validPort => pure validPort
  46 |     Nothing => fail "Port number must be between 0 and 65535"
  47 | 
  48 | private
  49 | parserPathItem : Parser String
  50 | parserPathItem = do
  51 |   token "/"
  52 |   s <- takeWhile $ allPass [(/= '/'), (/= '?'), (/= '#')]
  53 |   pure $ "/" ++ s
  54 | 
  55 | private
  56 | parserPath : Parser String
  57 | parserPath = do
  58 |   s <- some parserPathItem
  59 |   pure $ joinBy "" s
  60 | 
  61 | private
  62 | parserQueryItem : Parser QueryParam
  63 | parserQueryItem = do
  64 |   s <- sepBy1 (takeWhile $ allPass [(/= '#'), (/= '&'), (/= '=')]) (token "=")
  65 |   case s of
  66 |     (k ::: Nil) => pure (k, "")
  67 |     (k ::: vs) => pure (k, joinBy "" vs)
  68 |   
  69 | 
  70 | private
  71 | parserQuery : Parser (List QueryParam)
  72 | parserQuery = do
  73 |   token "?"
  74 |   l <- sepBy1 parserQueryItem $ token "&"
  75 |   pure $ forget l
  76 | 
  77 | private
  78 | parserFragment : Parser String
  79 | parserFragment = do
  80 |   token "#"
  81 |   takeWhile (\t => True)
  82 | 
  83 | private 
  84 | url : Parser HTTPURL
  85 | url = do
  86 |   scheme <- parserScheme
  87 |   content <- parserHost
  88 |   port <- optional parserPort
  89 |   path <- option "/" parserPath
  90 |   query <- option [] parserQuery
  91 |   fragment <- optional parserFragment
  92 |   eos
  93 |   pure $ MkHTTPURL scheme content port path query fragment
  94 | 
  95 | -- export function
  96 | public export
  97 | parse : String -> Maybe HTTPURL
  98 | parse str = case parse url str of
  99 |               Right (j,_) => Just j
 100 |               _ => Nothing
 101 |               
 102 | public export
 103 | stringify : HTTPURL -> String
 104 | stringify (MkHTTPURL scheme host port path query fragment) = scheme 
 105 |     ++ "://" ++ host ++ port' 
 106 |     ++ path ++ query' ++ fragment' 
 107 |   where 
 108 |     port' : String
 109 |     port' = case port of
 110 |       Nothing => ""
 111 |       (Just p) => ":" ++ show p
 112 | 
 113 |     query' : String
 114 |     query' = case query of
 115 |       [] => ""
 116 |       xs => "?" ++ (joinBy "&" $ map (\(a,b) => a ++ "=" ++ b) xs)
 117 | 
 118 |     fragment' : String
 119 |     fragment' = case fragment of
 120 |       Nothing => ""
 121 |       (Just f) => "#" ++ f