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

172 lines
6.0 KiB
Plaintext
Raw Normal View History

2023-07-22 15:48:00 +02:00
-- | `App.HomeInterface` presents the website and its features.
module App.HomeInterface where
2023-07-22 12:38:56 +02:00
2023-07-23 22:43:37 +02:00
import Prelude (Unit, map, show, ($), (<>))
import DomainParser as DomainParser
--import Data.Either (Either(..))
-- import Data.Maybe (Maybe(..), maybe)
-- import Data.Tuple (Tuple(..))
2023-07-22 15:48:00 +02:00
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
2023-07-23 22:43:37 +02:00
import Parsing
2023-07-22 15:48:00 +02:00
-- import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
2023-07-23 22:43:37 +02:00
2023-07-22 15:48:00 +02:00
import Bulma as Bulma
type Input = Unit
2023-07-23 22:43:37 +02:00
--type Action = Unit
2023-07-22 15:48:00 +02:00
data Action = UpdateStuff String
2023-07-23 22:43:37 +02:00
-- type State = Unit
type State = { stuff :: String }
2023-07-22 15:48:00 +02:00
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
}
}
2023-07-23 22:43:37 +02:00
-- handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
-- handleAction _ = pure unit
2023-07-22 15:48:00 +02:00
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
UpdateStuff val -> H.modify_ _ { stuff = val }
2023-07-23 22:43:37 +02:00
-- initialState :: forall input. input -> State
-- initialState _ = unit
2023-07-22 15:48:00 +02:00
initialState :: forall input. input -> State
initialState _ = { stuff: "" }
2023-07-23 22:43:37 +02:00
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"
]
2023-07-22 15:48:00 +02:00
render :: forall m. State -> H.ComponentHTML Action () m
render state
2023-07-23 22:43:37 +02:00
= 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"
2023-07-22 15:48:00 +02:00
, Bulma.section_small $
2023-07-23 22:43:37 +02:00
[ Bulma.h1 "Examples of domain parsing in Purescript"
] <> test_domains list_of_domains_to_test
2023-07-22 15:48:00 +02:00
, Bulma.section_small [ render_stuff ]
2023-07-23 14:06:09 +02:00
]
2023-07-22 15:48:00 +02:00
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
]
2023-07-23 22:43:37 +02:00
--, b [ title "result"
-- , p $ case runParser state.stuff DomainParser.parse_stuff of
-- Left _ -> "NOT OKAY"
-- Right _ -> "OKAY"
-- ]
2023-07-22 15:48:00 +02:00
]
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 -> _
2023-07-23 15:36:12 +02:00
test_domains doms = map tests_on_domain doms
2023-07-23 14:06:09 +02:00
2023-07-22 15:48:00 +02:00
-- tests_on_domain :: String -> _
tests_on_domain d
2023-07-23 15:36:12 +02:00
= b [ Bulma.strong $ d <> " -> [ldhstr, label, subdomain, domain]"
2023-07-23 22:43:37 +02:00
, 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)
2023-07-23 15:36:12 +02:00
]
2023-07-22 15:48:00 +02:00
2023-07-23 22:43:37 +02:00
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."
]
2023-07-23 15:36:12 +02:00
2023-07-23 22:43:37 +02:00
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: ..."
]
2023-07-22 12:38:56 +02:00
2023-07-23 22:43:37 +02:00
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."
]