halogen-websocket-ipc-playzone/drop/PlayingWithParsers.purs

-- | `App.HomeInterface` presents the website and its features.
module App.HomeInterface where

import Prelude (Unit, map, show, ($), (<>))
import DomainParser as DomainParser

--import Data.Either (Either(..))
-- import Data.Maybe (Maybe(..), maybe)
-- import Data.Tuple (Tuple(..))
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
import Parsing
-- import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP

import Bulma as Bulma

type Input = Unit
--type Action = Unit
data Action = UpdateStuff String
-- type State = Unit
type State = { stuff :: String }

data Query a = DoNothing a
type Output = Unit
type Slot = H.Slot Query Output

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 _ = pure unit

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 _ = unit

initialState :: forall input. input -> State
initialState _ = { stuff: "" }

list_of_domains_to_test :: Array String
list_of_domains_to_test
  = [ "ex.net"
    , "??"
    , "e-x.net"
    , "way-too-long--way-too-long--way-too-long--way-too-long--way-too-long.net"
    , "way-too-long--way-too-long--way-too-long--way-too-long.way-too-long--way-too-long--way-too-long--way-too-long.way-too-long--way-too-long--way-too-long--way-too-long.way-too-long--way-too-long--way-too-long--way-too-long.way-too-long--way-too-long--way-too-long--way-too-long.way-too-long--way-too-long--way-too-long--way-too-long.way-too-long--way-too-long--way-too-long--way-too-long.way-too-long--way-too-long--way-too-long--way-too-long.net"
    , "e-.net"
    , "-x.net"
    , "truc-blah.example.com"
    , "te.s-t.net"
    , "example.com"
    ]

render :: forall m. State -> H.ComponentHTML Action () m
render state
  = HH.div_
      [ Bulma.hero_danger
          "THIS IS AN ALPHA RELEASE"
          "Come back later!"
      , Bulma.section_small
          [ Bulma.h1 "Welcome to netlib.re"
          , Bulma.subtitle "Free domain names"
          , Bulma.hr
          , render_description
          , render_second_line
          , render_why_and_contact
          , Bulma.hr
          , render_how_and_code
          ]
      , Bulma.hero_danger "A simple input" "Nothing much to see"
      , Bulma.section_small $
          [ Bulma.h1 "Examples of domain parsing in Purescript"
          ] <> test_domains list_of_domains_to_test
      , 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 DomainParser.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 = map tests_on_domain doms

    -- tests_on_domain :: String -> _
    tests_on_domain d
      = b [ Bulma.strong $ d <> " -> [ldhstr, label, subdomain, domain]"
          , p $ d <> " : ldhstr     : " <> (show $ runParser d DomainParser.ldhstr)
          , p $ d <> " : label      : " <> (show $ runParser d DomainParser.label)
          , p $ d <> " : subdomain  : " <> (show $ runParser d DomainParser.subdomain)
          , p $ d <> " : domain     : " <> (show $ runParser d DomainParser.domain)
          ]

    render_description = Bulma.columns_ [ render_basics, render_no_expert ]
    render_basics
      = b [ title "What is provided?"
          , p "Reserve a domain name in <something>.netlib.re for free."
          , p "Manage your own DNS zone."
          ]
    render_no_expert
      = b [ title "No need to be an expert!"
          , p """
              This website will help you through your configuration, as much as we can.
              """
          ]
    render_second_line = Bulma.columns_ [ render_no_housing, render_updates ]
    render_no_housing
      = b [ title "No housing, just a name"
          , p """
              We don't provide housing for your services or websites,
              just a name.
              """
          ]
    render_updates
      = b [ title "Automatic updates"
          , p "Update your current address with a simple script."
          ]

    render_why_and_contact = Bulma.columns_ [ render_why, render_contact ]
    render_why
      = b [ title "Why?"
          , p "Because everyone should be able to have a place on the Internet."
          , p "We provide you a name, build something meaningful with it."
          ]
    render_contact
      = b [ title "Contact"
          , p "You have a question, you saw a bug or you just want to chat?"
          , p "You can contact us: ..."
          ]

    render_how_and_code = Bulma.columns_ [ render_how, render_code ]
    render_how
      = b [ title "How does this work?"
          , p "We pay for the domain names (netlib.re and codelib.re) and let you have a subdomain."
          , p "This service helps you manage your domain (a subdomain of netlib.re or codelib.re)."
          ]
    render_code
      = b [ title "I want to see the code!"
          , p "The project is fully open-source (ISC licence)."
          , p "There are 3 parts: libipc, micro-services (authentication and dnsmanager) and this website."
          ]