From a297cddb0edb86888d086d4be3739aac0247fa32 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 22 Jul 2023 15:48:00 +0200 Subject: [PATCH] Playing with parsers! --- drop/PlayingWithParsers.purs | 159 ++++++++++++++++++++++++++--------- 1 file changed, 118 insertions(+), 41 deletions(-) diff --git a/drop/PlayingWithParsers.purs b/drop/PlayingWithParsers.purs index 7680aeb..ebdbaf8 100644 --- a/drop/PlayingWithParsers.purs +++ b/drop/PlayingWithParsers.purs @@ -1,20 +1,124 @@ -module Main where +-- | `App.HomeInterface` presents the website and its features. +module App.HomeInterface 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 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.Alt ((<|>)) import Control.Lazy (defer) --- import Data.Array (many) +import Data.Array (many) +import Data.Either (Either(..)) +import Data.Foldable (fold) +import Data.Maybe (Maybe(..)) +import Data.String.CodeUnits as CU +-- import Data.String (joinWith) +-- import Data.String.Regex as R +-- import Data.String.Regex.Flags as RF +-- import Data.Tuple (Tuple(..)) +import Effect.Aff.Class (class MonadAff) +import Effect (Effect) +import Halogen as H +import Halogen.HTML as HH +-- import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import Parsing +import Parsing.Combinators as PC +import Parsing (Parser, runParser) +import Parsing.String +import Parsing.String.Basic +import Parsing.String.Basic (alphaNum, letter) +import Parsing.String (char, string, eof) +-- import TryPureScript (h1, h3, p, text, render, code) +import Bulma (h1, h3, p, text, code) +import Bulma as Bulma + +type Input = Unit +data Action = UpdateStuff String + +data Query a = DoNothing a +type Output = Unit +type Slot = H.Slot Query Output + +type State = { stuff :: String } + +component :: forall m. MonadAff m => H.Component Query Input Output m +component = + H.mkComponent + { initialState + , render + , eval: H.mkEval $ H.defaultEval + { handleAction = handleAction + } + } + +handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit +handleAction = case _ of + UpdateStuff val -> H.modify_ _ { stuff = val } + +initialState :: forall input. input -> State +initialState _ = { stuff: "" } + +render :: forall m. State -> H.ComponentHTML Action () m +render state + = HH.div_ $ + [ Bulma.hero_danger "A simple input" "Nothing much to see" + , Bulma.section_small $ + [ h1 "Examples of domain parsing in Purescript" + ] <> test_domains [ "ex.net", "e-.net", "-x.net", "te.s-t.net", "example.com" ] + , Bulma.section_small [ render_stuff ] + ] + where + -- Some helpers. + title = Bulma.h3 + p = Bulma.p + b x = Bulma.column_ [ Bulma.box x ] + + render_stuff = Bulma.columns_ [ b [ title "stuff" + , stuff_input + ] + , b [ title "result" + , p $ case runParser state.stuff parse_stuff of + Left _ -> "NOT OKAY" + Right _ -> "OKAY" + ] + ] + + stuff_input + = Bulma.box_input "stuff" "stuff" "stuff" + UpdateStuff + state.stuff + true + should_be_disabled + should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) + + -- test_domains :: Array String -> _ + test_domains doms = fold $ map tests_on_domain doms + + -- tests_on_domain :: String -> _ + tests_on_domain d + = [ text $ "domain: " <> d <> " [ldhstr, label, subdomain, domain]" + , p $ show $ runParser d ldhstr + , p $ show $ runParser d label + , p $ show $ runParser d subdomain + , p $ show $ runParser d domain + ] + +aye :: Parser String Char +aye = defer \_ -> char 'a' *> aye + +ayebee :: Parser String Boolean +ayebee = do + _ <- char 'a' + b <- char 'b' <|> char 'B' + pure (b == 'B') + +parse_stuff :: Parser String Boolean +parse_stuff = do + void $ alphaNum + void $ (void $ many (alphaNum <|> char '-' <|> char '.')) <|> eof + void $ eof + pure true + domain :: Parser String String domain = sub_eof <|> string " " @@ -52,12 +156,12 @@ label = PC.try let_then_str_then_alpha <|> PC.try let_then_alpha <|> let_to_stri pure $ CU.singleton l <> CU.singleton a ldhstr :: Parser String String -ldhstr = PC.try (defer \_ -> actual_ldhstr) <|> (defer \_ -> just_ldh) +ldhstr = PC.try actual_ldhstr <|> just_ldh where actual_ldhstr :: Parser String String actual_ldhstr = do ldh <- let_dig_hyp - str <- ldhstr + str <- defer \_ -> ldhstr pure $ CU.singleton ldh <> str just_ldh :: Parser String String @@ -88,32 +192,5 @@ let_to_string p = do -- ::= | -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" - ] <> 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 - - -- 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