-- | `App.HomeInterface` presents the website and its features. module App.HomeInterface where import Prelude import Control.Alt ((<|>)) import Control.Alt ((<|>)) import Control.Lazy (defer) 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 " " sub_eof :: Parser String String sub_eof = do sub <- PC.try subdomain eof pure sub subdomain :: Parser String String subdomain = PC.try label <|> defer \_ -> sub_point_label sub_point_label :: Parser String String sub_point_label = do sub <- defer \_ -> subdomain point <- string "." lab <- label pure $ sub <> point <> lab label :: Parser String String label = PC.try let_then_str_then_alpha <|> PC.try let_then_alpha <|> let_to_string letter where let_then_str_then_alpha :: Parser String String let_then_str_then_alpha = do l <- letter s <- ldhstr a <- alphaNum pure $ CU.singleton l <> s <> CU.singleton a let_then_alpha :: Parser String String let_then_alpha = do l <- letter a <- alphaNum pure $ CU.singleton l <> CU.singleton a ldhstr :: Parser String String ldhstr = PC.try actual_ldhstr <|> just_ldh where actual_ldhstr :: Parser String String actual_ldhstr = do ldh <- let_dig_hyp str <- defer \_ -> ldhstr pure $ CU.singleton ldh <> str just_ldh :: Parser String String just_ldh = let_to_string let_dig_hyp -- Not used currently. hyp_then_string :: Parser String String hyp_then_string = do a <- let_to_string let_dig_hyp b <- ldhstr pure $ a <> b -- Either a Letter, Digital or an Hyphenation character. let_dig_hyp :: Parser String Char let_dig_hyp = alphaNum <|> char '-' -- | Converting a single letter parser to a String parser. let_to_string :: Parser String Char -> Parser String String let_to_string p = do a <- p pure $ CU.singleton a -- From RFC 1035 --