Playing with parsers!

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 Control.Alt ((<|>))
-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.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