aboutsummaryrefslogtreecommitdiff
path: root/js
diff options
context:
space:
mode:
Diffstat (limited to 'js')
-rw-r--r--js/Dom.js12
-rw-r--r--js/Dom.purs74
-rw-r--r--js/EditableNumber.purs72
-rw-r--r--js/Main.purs56
-rw-r--r--js/Parser.purs76
5 files changed, 290 insertions, 0 deletions
diff --git a/js/Dom.js b/js/Dom.js
new file mode 100644
index 0000000..6835c1f
--- /dev/null
+++ b/js/Dom.js
@@ -0,0 +1,12 @@
+"use strict";
+
+exports.onInput = function (elt) {
+ return function (f) {
+ return function () {
+ elt.oninput = function(e) {
+ f(e.target.value)()
+ }
+ return {};
+ };
+ };
+};
diff --git a/js/Dom.purs b/js/Dom.purs
new file mode 100644
index 0000000..a71cda7
--- /dev/null
+++ b/js/Dom.purs
@@ -0,0 +1,74 @@
+module Dom
+ ( onInput
+ , selectElement
+ , selectElementFrom
+ , selectElementsFrom
+ , replaceElement
+ , appendNodes
+ , setValue
+ ) where
+
+import Control.Monad.Eff (Eff)
+import Control.Monad.Except (runExcept) as Except
+import Data.Array (range, catMaybes) as Array
+import Data.Either (Either(Right))
+import Data.Foreign (toForeign) as Foreign
+import Data.Maybe (Maybe(Nothing, Just))
+import Data.Traversable (sequence) as Traversable
+import Prelude
+
+import DOM (DOM)
+import DOM.HTML (window) as DOM
+import DOM.HTML.HTMLInputElement (setValue) as HTMLInputElement
+import DOM.HTML.Types (htmlDocumentToParentNode, readHTMLInputElement) as DOM
+import DOM.HTML.Window (document) as DOM
+import DOM.Node.Node (replaceChild, parentNode, appendChild) as DOM
+import DOM.Node.NodeList (length, item) as DOM
+import DOM.Node.ParentNode (QuerySelector)
+import DOM.Node.ParentNode (querySelector, querySelectorAll) as DOM
+import DOM.Node.Types (Element, Node)
+import DOM.Node.Types (elementToParentNode) as DOM
+
+foreign import onInput :: forall e. Element -> (String -> Eff (dom :: DOM | e) Unit) -> Eff (dom :: DOM | e) Unit
+
+selectElement :: forall e. QuerySelector -> Eff (dom :: DOM | e) (Maybe Element)
+selectElement query = do
+ document <- DOM.window >>= DOM.document
+ DOM.querySelector query (DOM.htmlDocumentToParentNode document)
+
+selectElementFrom :: forall e. Element -> QuerySelector -> Eff (dom :: DOM | e) (Maybe Element)
+selectElementFrom elem query = DOM.querySelector query (DOM.elementToParentNode elem)
+
+selectElementsFrom :: forall e. Element -> QuerySelector -> Eff (dom :: DOM | e) (Array Node)
+selectElementsFrom elem query = do
+ nodeList <- DOM.querySelectorAll query (DOM.elementToParentNode elem)
+ length <- DOM.length nodeList
+ Array.range 0 length
+ # map (\i -> DOM.item i nodeList)
+ # Traversable.sequence
+ # map Array.catMaybes
+
+replaceElement :: forall e. Node -> Node -> Eff (dom :: DOM | e) Unit
+replaceElement before after = do
+ parent <- DOM.parentNode before
+ case parent of
+ Just n -> do
+ _ <- DOM.replaceChild after before n
+ pure unit
+ Nothing ->
+ pure unit
+
+appendNodes :: forall e. Node -> Array Node -> Eff (dom :: DOM | e) Unit
+appendNodes parent nodes =
+ nodes
+ # map (\n -> DOM.appendChild n parent)
+ # Traversable.sequence
+ # map (const unit)
+
+setValue :: forall e. String -> Element -> Eff (dom :: DOM | e) Unit
+setValue value elem =
+ case Except.runExcept $ DOM.readHTMLInputElement (Foreign.toForeign elem) of
+ Right inputElem -> do
+ HTMLInputElement.setValue value inputElem
+ _ ->
+ pure unit
diff --git a/js/EditableNumber.purs b/js/EditableNumber.purs
new file mode 100644
index 0000000..eb5ddb0
--- /dev/null
+++ b/js/EditableNumber.purs
@@ -0,0 +1,72 @@
+module EditableNumber
+ ( NumberElem
+ , set
+ , formatNumber
+ ) where
+
+import Control.Monad.Eff (Eff)
+import Data.Int (round, toNumber, pow) as Int
+import Data.Maybe (Maybe(..))
+import Data.String (Pattern(..), Replacement(..))
+import Data.String (replace) as String
+import DOM (DOM)
+import DOM.HTML (window) as DOM
+import DOM.HTML.Types (htmlDocumentToDocument) as DOM
+import DOM.HTML.Window (document) as DOM
+import DOM.Node.Document (createElement, createTextNode) as DOM
+import DOM.Node.Element (setClassName, setAttribute) as DOM
+import DOM.Node.Node (textContent) as DOM
+import DOM.Node.Types (Element, Node)
+import DOM.Node.Types (elementToNode, textToNode) as DOM
+import Math (round) as Math
+import Prelude
+
+import Dom (replaceElement, appendNodes) as Dom
+import Parser (TextWithNumber)
+import Parser (textWithNumber) as Parser
+
+type NumberElem =
+ { elem :: Element
+ , number :: Number
+ }
+
+set :: forall e. { tag :: String, node :: Node } -> Eff (dom :: DOM | e) (Maybe NumberElem)
+set { tag, node } = do
+ content <- DOM.textContent node
+ case Parser.textWithNumber content of
+ Just twn -> do
+ textWithNumber <- textWithNumberElem tag twn
+ Dom.replaceElement node (DOM.elementToNode textWithNumber)
+ pure (Just { elem: textWithNumber, number: twn.number })
+ Nothing ->
+ pure Nothing
+
+textWithNumberElem :: forall e. String -> TextWithNumber -> Eff (dom :: DOM | e) Element
+textWithNumberElem tag { begin, number, end } = do
+ document <- DOM.htmlDocumentToDocument <$> (DOM.window >>= DOM.document)
+ elem <- DOM.createElement tag document
+ beginNode <- DOM.textToNode <$> DOM.createTextNode begin document
+ numberNode <- numberElem number
+ endNode <- DOM.textToNode <$> DOM.createTextNode end document
+ Dom.appendNodes (DOM.elementToNode elem) [ beginNode, DOM.elementToNode numberNode, endNode ]
+ pure elem
+
+numberElem :: forall e. Number -> Eff (dom :: DOM | e) Element
+numberElem number = do
+ document <- DOM.htmlDocumentToDocument <$> (DOM.window >>= DOM.document)
+ container <- DOM.createElement "input" document
+ DOM.setClassName "number" container
+ DOM.setAttribute "value" (formatNumber number) container
+ pure container
+
+formatNumber :: Number -> String
+formatNumber number =
+ if Math.round number == number then
+ show (Int.round number)
+ else
+ String.replace (Pattern ".") (Replacement ",") (show (roundAt 1 number))
+
+roundAt :: Int -> Number -> Number
+roundAt at n =
+ let exp = Int.toNumber (Int.pow 10 at)
+ in Math.round (n * exp) / exp
diff --git a/js/Main.purs b/js/Main.purs
new file mode 100644
index 0000000..062eb1d
--- /dev/null
+++ b/js/Main.purs
@@ -0,0 +1,56 @@
+module Main (main) where
+
+import Control.Monad.Eff (Eff)
+import Data.Array (catMaybes) as Array
+import Data.Maybe (Maybe(..))
+import Data.Traversable (sequence, sequence_) as Traversable
+import DOM (DOM)
+import DOM.Node.ParentNode (QuerySelector(..))
+import DOM.Node.Types (Node)
+import DOM.Node.Types (elementToNode) as DOM
+import Prelude
+
+import Dom (selectElement, selectElementsFrom, onInput, setValue, selectElementFrom) as Dom
+import EditableNumber (NumberElem)
+import EditableNumber (set, formatNumber) as EditableNumber
+import Parser (number) as Parser
+
+main :: forall e. Eff (dom :: DOM | e) Unit
+main = do
+ tagElems <- getNumberElements
+ numberElems <- Array.catMaybes <$> (Traversable.sequence $ map EditableNumber.set tagElems)
+ Traversable.sequence_ $ map (onInput numberElems) numberElems
+
+getNumberElements :: forall e. Eff (dom :: DOM | e) (Array { tag :: String, node :: Node })
+getNumberElements = do
+ h2 <- (map (\elem -> { tag: "h2", node: DOM.elementToNode elem})) <$> Dom.selectElement (QuerySelector "h2")
+ ul <- Dom.selectElement (QuerySelector "ul")
+ lis <- case ul of
+ Just elem -> do
+ myLis <- Dom.selectElementsFrom elem (QuerySelector "li")
+ pure $ map (\node -> { tag: "li", node: node }) myLis
+ _ -> do
+ pure []
+ pure $ (maybeToArray h2 <> lis)
+
+onInput :: forall e. Array NumberElem -> NumberElem -> Eff (dom :: DOM | e) Unit
+onInput numberElems { elem, number } = do
+ Dom.onInput elem (\value -> do
+ case Parser.number value of
+ Just newNumber ->
+ let mul = newNumber / number
+ in numberElems
+ # map (\ne -> do
+ inputNode <- Dom.selectElementFrom ne.elem (QuerySelector "input")
+ case inputNode of
+ Just node -> Dom.setValue (EditableNumber.formatNumber (ne.number * mul)) node
+ _ -> pure unit
+ )
+ # Traversable.sequence_
+ _ ->
+ pure unit
+ )
+
+maybeToArray :: forall a. Maybe a -> Array a
+maybeToArray (Just x) = [ x ]
+maybeToArray _ = []
diff --git a/js/Parser.purs b/js/Parser.purs
new file mode 100644
index 0000000..cad9f1b
--- /dev/null
+++ b/js/Parser.purs
@@ -0,0 +1,76 @@
+module Parser
+ ( TextWithNumber
+ , textWithNumber
+ , number
+ ) where
+
+import Control.Alt ((<|>))
+import Data.Array as Array
+import Data.Char as Char
+import Data.Either (Either(Right))
+import Data.Int as Int
+import Data.Maybe (fromMaybe) as Maybe
+import Data.Maybe (Maybe(Just, Nothing))
+import Data.String as String
+import Prelude
+import Text.Parsing.Parser (Parser)
+import Text.Parsing.Parser (runParser) as Parser
+import Text.Parsing.Parser.Combinators (optionMaybe) as Parser
+import Text.Parsing.Parser.String (satisfy, anyChar, string, eof) as Parser
+
+type TextWithNumber =
+ { begin :: String
+ , number :: Number
+ , end :: String
+ }
+
+textWithNumber :: String -> Maybe TextWithNumber
+textWithNumber input =
+ case Parser.runParser input textWithNumberParser of
+ Right x -> Just x
+ _ -> Nothing
+
+number :: String -> Maybe Number
+number input =
+ case Parser.runParser input (numberParser <* Parser.eof) of
+ Right x -> Just x
+ _ -> Nothing
+
+textWithNumberParser :: Parser String TextWithNumber
+textWithNumberParser = do
+ begin <- String.fromCharArray <$> Array.many notDigit
+ num <- numberParser
+ end <- String.fromCharArray <$> Array.many Parser.anyChar
+ pure { begin: begin, number: num, end: end }
+
+numberFromIntArray :: Array Int -> Int
+numberFromIntArray xs =
+ Array.range 0 (Array.length xs - 1)
+ # map (Int.pow 10)
+ # Array.reverse
+ # Array.zipWith (*) xs
+ # Array.foldl (+) 0
+
+notDigit :: Parser String Char
+notDigit = Parser.satisfy (not <<< isDigit)
+
+numberParser :: Parser String Number
+numberParser = do
+ whole <- numberFromIntArray <$> Array.some digit
+ decimal <- Parser.optionMaybe $ do
+ _ <- Parser.string "," <|> Parser.string "."
+ digits <- Array.some digit
+ let decimals = numberFromIntArray digits
+ pure $ Int.toNumber decimals / Int.toNumber (Int.pow 10 (Array.length digits))
+ pure (Int.toNumber whole + Maybe.fromMaybe 0.0 decimal)
+
+digit :: Parser String Int
+digit = map (\c -> Char.toCharCode c - zeroCode) $ Parser.satisfy isDigit
+
+isDigit :: Char -> Boolean
+isDigit char =
+ let code = Char.toCharCode char
+ in code >= zeroCode && code <= zeroCode + 9
+
+zeroCode :: Int
+zeroCode = 48
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 14:58:38 +0000