PlayingWithParsers

drop/PlayingWithParsers.purs

@@ -0,0 +1,77 @@
+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)
+    ]
+