Add tests for purescript number and parser utilities

6 files changed, 297 insertions, 0 deletions

diff --git a/js/src/Dom.js b/js/src/Dom.js
new file mode 100644
index 0000000..6835c1f
--- /dev/null
+++ b/js/src/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/src/Dom.purs b/js/src/Dom.purs
new file mode 100644
index 0000000..a71cda7
--- /dev/null
+++ b/js/src/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/src/EditableNumber.purs b/js/src/EditableNumber.purs
new file mode 100644
index 0000000..6a6e3a8
--- /dev/null
+++ b/js/src/EditableNumber.purs
@@ -0,0 +1,56 @@
+module EditableNumber
+  ( NumberElem
+  , set
+  ) where
+
+import Control.Monad.Eff (Eff)
+import Data.Maybe (Maybe(..))
+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 Prelude
+
+import Dom (replaceElement, appendNodes) as Dom
+import Number (format) as Number
+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" (Number.format number) container
+  pure container
diff --git a/js/src/Main.purs b/js/src/Main.purs
new file mode 100644
index 0000000..42db131
--- /dev/null
+++ b/js/src/Main.purs
@@ -0,0 +1,57 @@
+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 (elementToNode) as DOM
+import DOM.Node.Types (Node)
+import Prelude
+
+import Dom (selectElement, selectElementsFrom, onInput, setValue, selectElementFrom) as Dom
+import EditableNumber (NumberElem)
+import EditableNumber (set) as EditableNumber
+import Number (format) as Number
+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 (Number.format (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/src/Number.purs b/js/src/Number.purs
new file mode 100644
index 0000000..0403f19
--- /dev/null
+++ b/js/src/Number.purs
@@ -0,0 +1,22 @@
+module Number
+  ( format
+  , roundAt
+  ) where
+
+import Data.Int (round, toNumber, pow) as Int
+import Data.String (Pattern(..), Replacement(..))
+import Data.String (replace) as String
+import Math (round) as Math
+import Prelude
+
+format :: Number -> String
+format 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/src/Parser.purs b/js/src/Parser.purs
new file mode 100644
index 0000000..cad9f1b
--- /dev/null
+++ b/js/src/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