From 4399097564c041838140225f30dcda7f92caa88a Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 10 May 2017 10:29:30 +0200 Subject: Add tests for purescript number and parser utilities --- js/src/Dom.js | 12 ++++++++ js/src/Dom.purs | 74 ++++++++++++++++++++++++++++++++++++++++++++ js/src/EditableNumber.purs | 56 ++++++++++++++++++++++++++++++++++ js/src/Main.purs | 57 ++++++++++++++++++++++++++++++++++ js/src/Number.purs | 22 ++++++++++++++ js/src/Parser.purs | 76 ++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 297 insertions(+) create mode 100644 js/src/Dom.js create mode 100644 js/src/Dom.purs create mode 100644 js/src/EditableNumber.purs create mode 100644 js/src/Main.purs create mode 100644 js/src/Number.purs create mode 100644 js/src/Parser.purs (limited to 'js/src') 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 -- cgit v1.2.3