78 lines
2.0 KiB
Plaintext
78 lines
2.0 KiB
Plaintext
module PlayingWithParsers where
|
|
|
|
import Prelude
|
|
|
|
import Data.Foldable (fold)
|
|
import Effect (Effect)
|
|
import TryPureScript (h1, h3, p, text, render, code)
|
|
import Parsing (Parser, runParser)
|
|
import Parsing.Combinators as PC
|
|
import Parsing.String (char, string)
|
|
import Parsing.String.Basic (alphaNum, letter)
|
|
import Control.Alt ((<|>))
|
|
import Control.Lazy (defer)
|
|
import Data.Array (many)
|
|
|
|
domain :: Parser String String
|
|
domain = subdomain <|> string " "
|
|
|
|
subdomain :: Parser String String
|
|
subdomain = label <|> defer \_ -> subdomain *> string "." *> label
|
|
|
|
label :: Parser String String
|
|
label = PC.try let_str_alpha <|> let_alpha <|> (letter >>= \_ -> string "")
|
|
|
|
let_str_alpha :: Parser String String
|
|
let_str_alpha = do
|
|
_ <- letter
|
|
_ <- ldhstr
|
|
_ <- alphaNum
|
|
pure ""
|
|
|
|
let_alpha :: Parser String String
|
|
let_alpha = do
|
|
_ <- letter
|
|
_ <- alphaNum
|
|
pure ""
|
|
|
|
ldhstr :: Parser String String
|
|
ldhstr = let_dig_hyp *> (defer \_ -> ldhstr) <|> defer \_ -> let_dig_hyp *> string ""
|
|
|
|
let_dig_hyp :: Parser String Char
|
|
let_dig_hyp = alphaNum <|> char '-'
|
|
|
|
aye :: Parser String Char
|
|
aye = defer \_ -> char 'a' *> aye
|
|
|
|
-- From RFC 1035
|
|
-- <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
|
|
-- <ldh-str> ::= <let-dig-hyp> | <let-dig-hyp> <ldh-str>
|
|
-- <let-dig-hyp> ::= <let-dig> | "-"
|
|
-- <let-dig> ::= <letter> | <digit>
|
|
|
|
|
|
ayebee :: Parser String Boolean
|
|
ayebee = do
|
|
_ <- alphaNum
|
|
b <- char 'b' <|> alphaNum
|
|
pure (b == 'B')
|
|
|
|
tested_domain :: String
|
|
tested_domain = "example.com"
|
|
|
|
main :: Effect Unit
|
|
main =
|
|
render $ fold
|
|
[ h1 $ text "Examples of domain parsing in Purescript"
|
|
|
|
, p $ text "Run the " <> (code $ text "domain") <> text " parser."
|
|
, h3 $ code (text $ "runParser '" <> tested_domain <> "' domain")
|
|
, h3 $ code $ text $ show $ runParser tested_domain domain
|
|
|
|
, h1 $ text "something else"
|
|
, p $ text "Run the " <> code (text "ayebee") <> text " parser with the " <> code (text "many") <> text " combinator."
|
|
, h3 $ code (text "runParser \"aBabaB\" (many ayebee)")
|
|
, h3 $ code $ text $ show $ runParser "aBabax" (many ayebee)
|
|
]
|
|
|