halogen-websocket-ipc-playzone/drop/PlayingWithParsers.purs

78 lines
2.0 KiB
Plaintext
Raw Normal View History

2023-07-22 12:38:56 +02:00
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)
]