keera-hails-reactive-htmldom (empty) → 0.6.0
raw patch · 6 files changed
+331/−0 lines, 6 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, ghcjs-dom, hlint, keera-callbacks, keera-hails-reactive-cbmvar, keera-hails-reactivevalues, mtl, process, regex-posix, transformers
Files
- LICENSE +31/−0
- Setup.hs +2/−0
- keera-hails-reactive-htmldom.cabal +116/−0
- src/Hails/MVC/View/HTML.hs +68/−0
- tests/HLintMain.hs +23/−0
- tests/HaddockCoverage.hs +91/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2013-2020, Keera Studios Ltd+Copyright (c) 2010-2012, Ivan Perez++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the+ names of other contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ keera-hails-reactive-htmldom.cabal view
@@ -0,0 +1,116 @@+-- Copyright : (C) Keera Studios Ltd, 2013+-- License : All Rights Reserved+-- Maintainer : support@keera.co.uk+--+cabal-version: >=1.10+build-type: Simple++name: keera-hails-reactive-htmldom+author: Ivan Perez+maintainer: support@keera.co.uk+homepage: http://github.com/keera-studios/keera-hails+license: BSD3+license-file: LICENSE+category: Web+version: 0.6.0+synopsis: Keera Hails Reactive bindings for HTML DOM via GHCJS+description:+ A layer defining RVs for HTML element fields and actions.+ .+ Reactive Values are an abstraction for reactive programming based on setters+ and getters with change-based propagation.+ .+ They enable easy communication/synchronization rules via Reactive Rules+ (RRs), which can keep two type-compatible RVs in sync directionally or+ bidirectionally.+ .+ This library provides operations to turn HTML element properties and+ fields into RVs, so that they can be used to create reactive user+ interfaces with minimal effort.+ .+ For details, please see the paper "Bridging the GUI Gap with Reactive Values+ and Relations", by Ivan Perez and Henrik Nilsson at Haskell Symposium 2015.++source-repository head+ type: git+ location: git://github.com/keera-studios/keera-hails+ subdir: keera-hails-reactive-htmldom+++-- You can disable the hlint test suite with -f-test-hlint+flag test-hlint+ default: False+ manual: True++-- You can disable the haddock coverage test suite with -f-test-doc-coverage+flag test-doc-coverage+ default: False+ manual: True+++library++ exposed-modules:+ Hails.MVC.View.HTML++ build-depends:+ base >=4.2 && <5+ , ghcjs-dom >=0.2 && <0.10+ , keera-callbacks+ , keera-hails-reactivevalues >=0.1.0 && <0.6+ , keera-hails-reactive-cbmvar+ , mtl+ , transformers >=0.4.3.0 && <0.6++ hs-source-dirs: src/+ default-language: Haskell2010++test-suite hlint++ type:+ exitcode-stdio-1.0++ main-is:+ HLintMain.hs++ hs-source-dirs:+ tests++ if !flag(test-hlint)+ buildable: False+ else+ build-depends:+ base+ , hlint >= 1.7++ default-language:+ Haskell2010+++-- Verify that the code is thoroughly documented+test-suite haddock-coverage++ type:+ exitcode-stdio-1.0++ main-is:+ HaddockCoverage.hs++ ghc-options:+ -Wall++ hs-source-dirs:+ tests++ if !flag(test-doc-coverage)+ buildable: False+ else+ build-depends:+ base >= 4 && < 5+ , directory+ , filepath+ , process+ , regex-posix++ default-language:+ Haskell2010
+ src/Hails/MVC/View/HTML.hs view
@@ -0,0 +1,68 @@+-- |+--+-- Copyright : (C) Keera Studios Ltd, 2013+-- License : BSD3+-- Maintainer : support@keera.co.uk+module Hails.MVC.View.HTML where++import Control.Applicative ((<$>))+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader (ask)+import Data.CBMVar (installCallbackCBMVar, newCBMVar,+ readCBMVar, writeCBMVar)+import Data.CBMVar.Reactive (cbmvarReactiveRO, cbmvarReactiveRW)+import Data.ReactiveValue+import Data.String+import GHCJS.DOM.Element (IsElement, setInnerHTML)+import GHCJS.DOM.EventM (mouseButton, mouseClientXY, on)+import GHCJS.DOM.EventTargetClosures (EventName, unsafeEventName)+import GHCJS.DOM.GlobalEventHandlers (input, mouseDown, mouseMove)+import GHCJS.DOM.HTMLElement (setInnerText)+import GHCJS.DOM.HTMLInputElement (getValue, setValue)+import GHCJS.DOM.HTMLParagraphElement (HTMLParagraphElement (..))+import GHCJS.DOM.MessageEvent (getData)+import GHCJS.DOM.Types (HTMLElement, HTMLInputElement (..),+ IsGlobalEventHandlers, IsHTMLElement,+ JSString, MouseEvent, fromJSValUnchecked,+ toHTMLElement, toJSString)+import GHCJS.DOM.WebSocket (WebSocket, message, sendString)++-- * GHCJS DOM Reactive API+inputTextReactive :: HTMLInputElement -> ReactiveFieldReadWrite IO String+inputTextReactive x = ReactiveFieldReadWrite setter getter notifier+ where setter = setValue x+ getter = getValue x+ notifier p = void $ on x input (liftIO p)++htmlElementClick :: IsHTMLElement e => e -> ReactiveFieldRead IO ()+htmlElementClick e = ReactiveFieldRead (return ()) (\p -> void $ on e' click (liftIO p))+ where+ e' = toHTMLElement e++click :: EventName HTMLElement MouseEvent+click = unsafeEventName (toJSString "click")++paragraphTextReactive :: HTMLParagraphElement -> ReactiveFieldWrite IO String+paragraphTextReactive x = ReactiveFieldWrite setter+ where setter = setInnerHTML x++websocketReactive :: WebSocket -> IO (ReactiveFieldReadWrite IO String)+websocketReactive socket = do+ p <- newCBMVar ""+ void $ on socket message (ask >>= \dt -> getData dt >>= \js -> liftIO (fromJSValUnchecked js) >>= \jss -> liftIO (writeCBMVar p (show (jss :: JSString))))+ let getter = readCBMVar p+ notifier n = installCallbackCBMVar p n+ setter x = do+ sendString socket (fromString x :: JSString)+ writeCBMVar p x+ return (ReactiveFieldReadWrite setter getter notifier)++mouseDownReactive :: (IsGlobalEventHandlers a, IsElement a) => a -> ReactiveFieldRead IO ()+mouseDownReactive s = eventR $ \p -> void $ on s mouseDown (liftIO p)++mousePosElementReactive :: (IsGlobalEventHandlers e, IsElement e) => e -> IO (ReactiveFieldRead IO (Int, Int))+mousePosElementReactive e = do+ p <- newCBMVar (0,0)+ void $ on e mouseMove (mouseClientXY >>= \pos -> liftIO (writeCBMVar p pos))+ return (cbmvarReactiveRO p)
+ tests/HLintMain.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module : Main (hlint)+-- Copyright : (C) 2013 Edward Kmett+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- This module runs HLint on the lens source tree.+-----------------------------------------------------------------------------+module Main where++import Control.Monad+import Language.Haskell.HLint+import System.Environment+import System.Exit++main :: IO ()+main = do+ args <- getArgs+ hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args+ unless (null hints) exitFailure
+ tests/HaddockCoverage.hs view
@@ -0,0 +1,91 @@+-----------------------------------------------------------------------------+-- |+-- Module : Main (HaddockCoverage)+-- Copyright : (C) 2015 Ivan Perez+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ivan Perez <ivan.perez@keera.co.uk>+-- Stability : provisional+-- Portability : portable+--+-- Copyright notice: This file borrows code+-- https://hackage.haskell.org/package/lens-4.7/src/tests/doctests.hsc+-- which is itself licensed BSD-style as well.+--+-- Run haddock on a source tree and report if anything in any+-- module is not documented.+-----------------------------------------------------------------------------+module Main where++import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.Exit+import System.FilePath+import System.IO+import System.Process+import Text.Regex.Posix++main :: IO ()+main = do+ -- Find haskell modules+ -- TODO: Ideally cabal should do this (provide us with the+ -- list of modules). An alternative would be to use cabal haddock+ -- but that would need a --no-html argument or something like that.+ -- Alternatively, we could use cabal haddock with additional arguments.+ --+ -- See:+ -- https://github.com/keera-studios/haddock/commit/d5d752943c4e5c6c9ffcdde4dc136fcee967c495+ -- https://github.com/haskell/haddock/issues/309#issuecomment-150811929+ files <- getSources++ let haddockArgs = [ "--no-warnings", "--ignore-all-exports" ] ++ files+ let cabalArgs = [ "exec", "--", "haddock" ] ++ haddockArgs+ (code, out, _err) <- readProcessWithExitCode "cabal" cabalArgs ""++ -- Filter out coverage lines, and find those that denote undocumented+ -- modules.+ --+ -- TODO: is there a way to annotate a function as self-documenting,+ -- in the same way we do with ANN for hlint?+ let isIncompleteModule :: String -> Bool+ isIncompleteModule line = isCoverageLine line && not (line =~ "^ *100%")+ where isCoverageLine :: String -> Bool+ isCoverageLine line = line =~ "^ *[0-9]+%"++ let incompleteModules :: [String]+ incompleteModules = filter isIncompleteModule $ lines out++ -- Based on the result of haddock, report errors and exit.+ -- Note that, unline haddock, this script does not+ -- output anything to stdout. It uses stderr instead+ -- (as it should).+ case (code, incompleteModules) of+ (ExitSuccess , []) -> return ()+ -- (ExitFailure _, _) -> exitFailure+ (_ , _) -> do+ hPutStrLn stderr "The following modules are not fully documented:"+ mapM_ (hPutStrLn stderr) incompleteModules+ exitFailure++getSources :: IO [FilePath]+getSources = filter isHaskellFile <$> go "src"+ where+ go dir = do+ (dirs, files) <- getFilesAndDirectories dir+ (files ++) . concat <$> mapM go dirs++ isHaskellFile fp = (isSuffixOf ".hs" fp || isSuffixOf ".lhs" fp)+ && not (any (`isSuffixOf` fp) excludedFiles)++ excludedFiles = [ ]++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c++-- find-based implementation (not portable)+--+-- getSources :: IO [FilePath]+-- getSources = fmap lines $ readProcess "find" ["src/", "-iname", "*hs"] ""