Last commit before BOOM.

drop/PlayingWithParsers.purs

@@ -102,16 +102,16 @@ render state
     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
+    test_domains doms = map tests_on_domain doms
 
     -- tests_on_domain :: String -> _
     tests_on_domain d
-      = [ Bulma.strong $ d <> " -> [ldhstr, label, subdomain, domain]"
-        , p $ d <> " : ldhstr     : " <> (show $ runParser d ldhstr)
-        , p $ d <> " : label      : " <> (show $ runParser d label)
-        , p $ d <> " : subdomain  : " <> (show $ runParser d subdomain)
-        , p $ d <> " : domain     : " <> (show $ runParser d domain)
-        ]
+      = b [ Bulma.strong $ d <> " -> [ldhstr, label, subdomain, domain]"
+          , p $ d <> " : ldhstr     : " <> (show $ runParser d ldhstr)
+          , p $ d <> " : label      : " <> (show $ runParser d label)
+          , p $ d <> " : subdomain  : " <> (show $ runParser d subdomain)
+          , p $ d <> " : domain     : " <> (show $ runParser d domain)
+          ]
 
 aye :: Parser String Char
 aye = defer \_ -> char 'a' *> aye
@@ -139,21 +139,24 @@ sub_eof = do
   sub <- subdomain
   -- TODO: optional "." at the end?
   eof
-  pure sub
+  if S.length sub > 255
+  then fail $ "domain length is > 255 bytes (" <> show (S.length sub) <> ")"
+  else pure sub
 
 -- From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
 subdomain :: Parser String String
-subdomain = defer \_ -> sub_point_label <|> label
-
-sub_point_label :: Parser String String
-sub_point_label = do
+subdomain = do
+  -- First: read a label. This is bare minimum for a subdomain.
   lab <- label
-  point <- string "."
-  sub <- defer \_ -> subdomain
-  let result = lab <> point <> sub
-  if S.length result > 255
-  then fail $ "domain length is > 255 bytes (" <> show (S.length result) <> ")"
-  else pure result
+  -- Second: the rest is optional. TODO
+  -- TODO
+  where
+    point_sub :: Parser String String
+    point_sub = do
+      point <- string "."
+      sub <- defer \_ -> subdomain
+      pure $ point <> sub
+
 
 -- From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
 label :: Parser String String
@@ -162,7 +165,7 @@ label = let_then_str_then_alpha
     let_then_str_then_alpha :: Parser String String
     let_then_str_then_alpha = do
       l <- letter
-      s <- many let_dig_hyp
+      s <- ldhstr
       case last s of
         Nothing -> pure $ CU.singleton l
         Just last_char -> case runParser (CU.singleton last_char) alphaNum of
@@ -172,22 +175,13 @@ label = let_then_str_then_alpha
                      else pure $ CU.singleton l <> CU.fromCharArray (foldl (\acc x -> snoc acc x) [] s)
 
 -- From RFC 1035: <ldh-str> ::= <let-dig-hyp> | <let-dig-hyp> <ldh-str>
-ldhstr :: Parser String String
-ldhstr = PC.try ldh_then_str <|> just_ldh
-  where
-    just_ldh :: Parser String String
-    just_ldh = char_to_string let_dig_hyp
-
-    ldh_then_str :: Parser String String
-    ldh_then_str = do
-      ldh <- let_dig_hyp
-      str <- defer \_ -> ldhstr
-      pure $ CU.singleton ldh <> str
+ldhstr :: Parser String (Array Char)
+ldhstr = many let_dig_hyp
 
 -- From RFC 1035: <let-dig-hyp> ::= <let-dig> | "-"
 -- Either a Letter, Digital or an Hyphenation character.
 let_dig_hyp :: Parser String Char
-let_dig_hyp = let_dig <|> char '-'
+let_dig_hyp = let_dig <|> char '-' -- TODO: push error
 
 -- From RFC 1035: <let-dig> ::= <letter> | <digit>
 let_dig :: Parser String Char
@@ -196,8 +190,8 @@ let_dig = alphaNum
 -- | Converting a single letter parser to a String parser.
 char_to_string :: Parser String Char -> Parser String String
 char_to_string p = do
-  a <- p
-  pure $ CU.singleton a
+  character <- p
+  pure $ CU.singleton character
 
 -- Not used currently.
 hyp_then_string :: Parser String String