Playing with parsers!

beta
Philippe Pittoli 2023-07-22 15:48:00 +02:00
parent 99eedc1c15
commit a297cddb0e
1 changed files with 118 additions and 41 deletions

View File

@ -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
-- <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"
] <> 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