Playing with parsers!
This commit is contained in:
parent
99eedc1c15
commit
a297cddb0e
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user