Playing with parsers some more.
This commit is contained in:
parent
fb2b4ec86a
commit
37de517c60
@ -1,4 +1,4 @@
|
||||
module PlayingWithParsers where
|
||||
module Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
@ -7,42 +7,79 @@ 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 Data.String.CodeUnits as CU
|
||||
-- import Data.String (joinWith)
|
||||
|
||||
import Parsing.String (char, string, eof)
|
||||
import Parsing.String.Basic (alphaNum, letter)
|
||||
import Control.Alt ((<|>))
|
||||
import Control.Lazy (defer)
|
||||
import Data.Array (many)
|
||||
-- import Data.Array (many)
|
||||
|
||||
domain :: Parser String String
|
||||
domain = subdomain <|> string " "
|
||||
domain = sub_eof <|> string " "
|
||||
|
||||
sub_eof :: Parser String String
|
||||
sub_eof = do
|
||||
sub <- PC.try subdomain
|
||||
eof
|
||||
pure sub
|
||||
|
||||
subdomain :: Parser String String
|
||||
subdomain = label <|> defer \_ -> subdomain *> string "." *> label
|
||||
subdomain = PC.try label <|> defer \_ -> sub_point_label
|
||||
|
||||
sub_point_label :: Parser String String
|
||||
sub_point_label = do
|
||||
sub <- defer \_ -> subdomain
|
||||
point <- string "."
|
||||
lab <- label
|
||||
pure $ sub <> point <> lab
|
||||
|
||||
label :: Parser String String
|
||||
label = PC.try let_str_alpha <|> let_alpha <|> (letter >>= \_ -> string "")
|
||||
label = PC.try let_then_str_then_alpha <|> PC.try let_then_alpha <|> let_to_string letter
|
||||
where
|
||||
let_then_str_then_alpha :: Parser String String
|
||||
let_then_str_then_alpha = do
|
||||
l <- letter
|
||||
s <- ldhstr
|
||||
a <- alphaNum
|
||||
pure $ CU.singleton l <> s <> CU.singleton a
|
||||
|
||||
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 ""
|
||||
let_then_alpha :: Parser String String
|
||||
let_then_alpha = do
|
||||
l <- letter
|
||||
a <- alphaNum
|
||||
pure $ CU.singleton l <> CU.singleton a
|
||||
|
||||
ldhstr :: Parser String String
|
||||
ldhstr = let_dig_hyp *> (defer \_ -> ldhstr) <|> defer \_ -> let_dig_hyp *> string ""
|
||||
ldhstr = PC.try (defer \_ -> actual_ldhstr) <|> (defer \_ -> just_ldh)
|
||||
where
|
||||
actual_ldhstr :: Parser String String
|
||||
actual_ldhstr = do
|
||||
ldh <- let_dig_hyp
|
||||
str <- ldhstr
|
||||
pure $ CU.singleton ldh <> str
|
||||
|
||||
just_ldh :: Parser String String
|
||||
just_ldh = let_to_string let_dig_hyp
|
||||
|
||||
-- Not used currently.
|
||||
hyp_then_string :: Parser String String
|
||||
hyp_then_string = do
|
||||
a <- let_to_string let_dig_hyp
|
||||
b <- ldhstr
|
||||
pure $ a <> b
|
||||
|
||||
-- Either a Letter, Digital or an Hyphenation character.
|
||||
let_dig_hyp :: Parser String Char
|
||||
let_dig_hyp = alphaNum <|> char '-'
|
||||
|
||||
aye :: Parser String Char
|
||||
aye = defer \_ -> char 'a' *> aye
|
||||
-- | Converting a single letter parser to a String parser.
|
||||
let_to_string :: Parser String Char -> Parser String String
|
||||
let_to_string p = do
|
||||
a <- p
|
||||
pure $ CU.singleton a
|
||||
|
||||
|
||||
-- From RFC 1035
|
||||
-- <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
|
||||
@ -62,16 +99,21 @@ tested_domain = "example.com"
|
||||
|
||||
main :: Effect Unit
|
||||
main =
|
||||
render $ fold
|
||||
render $ fold $
|
||||
[ h1 $ text "Examples of domain parsing in Purescript"
|
||||
] <> test_domains [ "ex.net", "e-.net", "-x.net", "te.s-t.net", "example.com" ]
|
||||
where
|
||||
-- test_domains :: Array String -> _
|
||||
test_domains doms = fold $ map tests_on_domain doms
|
||||
|
||||
, 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)
|
||||
-- tests_on_domain :: String -> _
|
||||
tests_on_domain d
|
||||
= [ h3 $ code (text $ "domain: " <> d <> " [ldhstr, label, subdomain, domain]")
|
||||
, p $ code $ text $ show $ runParser d ldhstr
|
||||
, p $ code $ text $ show $ runParser d label
|
||||
, p $ code $ text $ show $ runParser d subdomain
|
||||
, p $ code $ text $ show $ runParser d domain
|
||||
]
|
||||
|
||||
aye :: Parser String Char
|
||||
aye = defer \_ -> char 'a' *> aye
|
||||
|
Loading…
Reference in New Issue
Block a user