Shpadoinkle-html 0.3.0.0 → 0.3.0.1
raw patch · 12 files changed
+153/−114 lines, 12 filesdep +directorydep +process
Dependencies added: directory, process
Files
- CHANGELOG.md +0/−0
- README.md +2/−52
- Shpadoinkle-html.cabal +55/−40
- Shpadoinkle/Html.hs +4/−5
- Shpadoinkle/Html/Event.hs +1/−0
- Shpadoinkle/Html/Event/Basic.hs +1/−1
- Shpadoinkle/Html/Event/Debounce.hs +1/−2
- Shpadoinkle/Html/Property.hs +31/−12
- Shpadoinkle/Html/TH/AssetLink.hs +27/−0
- Shpadoinkle/Html/TH/CSS.hs +8/−2
- Shpadoinkle/Html/TH/CSSTest.hs +1/−0
- sample.css +22/−0
− CHANGELOG.md
README.md view
@@ -1,6 +1,6 @@ # Shpadoinkle Html -[](https://gitlab.com/fresheyeball/Shpadoinkle)+[](https://gitlab.com/platonic/shpadoinkle) [](https://shpadoinkle.org/html) [](https://opensource.org/licenses/BSD-3-Clause) [](https://builtwithnix.org)@@ -8,54 +8,4 @@ [](http://packdeps.haskellers.com/reverse/Shpadoinkle-html) [](https://matrix.hackage.haskell.org/#/package/Shpadoinkle-html) -This module provides named functions for generating Html, and other browser utilities.--For example, instead of writing:--```haskell-view = h "div" [ ("class", PText "foo") ]- [ h "span" [] [ text "hi there" ] ]-```--You can write:--```haskell-view = div "foo" [ span_ [ "hi there" ] ]-```--which is a bit nicer, and eleminates the risk of typeos in tag names. It also-provies some nice `IsString` instances for ergonomics.--## Keyboard--This module provides pattern synonyms for common key codes. For example:--```haskell-div [ onKeyup $ \case- Enter -> fireLazors- UpArrow -> jump- DownArrow -> crouch- LeftArrow -> move -1- RightArrow -> move 1- ]-```--which is a bit nicer, and harder to get wrong than using magic int's to-identify keys.--## Browser utilities--We provide high-level APIs to lower-level browser APIs. Including:--- Local Storage--I know it's just one right now.-But this is the place to contribute more. Such as:--- Scroll Position-- XHR Requests-- Visibility API-- Notifications-- ect...--+## [Documentation ->](https://shpadoinkle.org/packages/html)
Shpadoinkle-html.cabal view
@@ -1,61 +1,74 @@-cabal-version: 1.12+cabal-version: 2.2+name: Shpadoinkle-html+version: 0.3.0.1+category: Web+author: Isaac Shapira+maintainer: isaac.shapira@platonic.systems+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+synopsis:+ A typed, template generated Html DSL, and helpers.+description:+ Shpadoinkle Html is a typed template-generated Html DSL building on types provided+ by Shpadoinkle Core. This exports a large namespace of terms covering most of the+ Html specifications. Some Elm-API-style helpers are present, but as outlaw type classes. --- This file has been generated from package.yaml by hpack version 0.33.0.------ see: https://github.com/sol/hpack------ hash: 507af092ca806a47783a31cc85707dba844dd89d06c3deba1589d0ea7678b193 -name: Shpadoinkle-html-version: 0.3.0.0-synopsis: A typed, template generated Html DSL, and helpers.-description: Shpadoinkle Html is a typed template-generated Html DSL building on types provided by Shpadoinkle Core. This exports a large namespace of terms covering most of the Html specifications. Some Elm-API-style helpers are present, but as outlaw type classes.-category: Web-author: Isaac Shapira-maintainer: fresheyeball@protonmail.com-license: BSD3-license-file: LICENSE-build-type: Simple-extra-source-files:- README.md- CHANGELOG.md+extra-source-files: sample.css + source-repository head type: git- location: https://gitlab.com/fresheyeball/Shpadoinkle.git+ location: https://gitlab.com/platonic/shpadoinkle.git + library exposed-modules:- Shpadoinkle.Html- Shpadoinkle.Html.Element- Shpadoinkle.Html.Event- Shpadoinkle.Html.Property- Shpadoinkle.Html.Memo- Shpadoinkle.Html.MicroData- Shpadoinkle.Html.Utils- Shpadoinkle.Html.LocalStorage- Shpadoinkle.Html.TH- Shpadoinkle.Html.TH.CSS- Shpadoinkle.WebWorker- Shpadoinkle.Keyboard+ Shpadoinkle.Html+ Shpadoinkle.Html.Element+ Shpadoinkle.Html.Event+ Shpadoinkle.Html.Property+ Shpadoinkle.Html.Memo+ Shpadoinkle.Html.MicroData+ Shpadoinkle.Html.Utils+ Shpadoinkle.Html.LocalStorage+ Shpadoinkle.Html.TH+ Shpadoinkle.Html.TH.AssetLink+ Shpadoinkle.Html.TH.CSS+ Shpadoinkle.WebWorker+ Shpadoinkle.Keyboard+ other-modules:- Shpadoinkle.Html.Event.Basic- Shpadoinkle.Html.Event.Debounce- Shpadoinkle.Html.Event.Throttle- Shpadoinkle.Html.TH.CSSTest- Paths_Shpadoinkle_html- hs-source-dirs:- ./.- ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities+ Shpadoinkle.Html.Event.Basic+ Shpadoinkle.Html.Event.Debounce+ Shpadoinkle.Html.Event.Throttle+ Shpadoinkle.Html.TH.CSSTest++ hs-source-dirs: .++ ghc-options:+ -Wall+ -Wcompat+ -fwarn-redundant-constraints+ -fwarn-incomplete-uni-patterns+ -fwarn-tabs+ -fwarn-incomplete-record-updates+ -fwarn-identities+ build-depends: Shpadoinkle , base >=4.12.0 && <4.16 , bytestring , compactable , containers >=0.6.0 && <0.7+ , directory , ghcjs-dom , jsaddle >=0.9.7 && <0.20 , lens+ , process , raw-strings-qq , stm >=2.5.0 && <2.6 , template-haskell >=2.14.0 && <2.17@@ -63,10 +76,12 @@ , time , transformers , unliftio+ if impl(ghcjs) build-depends: ghcjs-base else build-depends: regex-pcre+ default-language: Haskell2010
Shpadoinkle/Html.hs view
@@ -11,12 +11,11 @@ ) where -import Shpadoinkle (Html, Prop, baked, children,- dataProp, injectProps, listen,+import Shpadoinkle (Html, Prop, baked, dataProp,+ h, injectProps, listen, listenC, listenRaw, listener,- listenerProp, mapChildren,- mapProps, name, props, text,- textContent)+ listenerProp, mapProps, text,+ textProp) import Shpadoinkle.Html.Element import Shpadoinkle.Html.Event import Shpadoinkle.Html.Event.Debounce
Shpadoinkle/Html/Event.hs view
@@ -164,6 +164,7 @@ onEscapeC c = onKeyupC $ \case 27 -> c; _ -> done $(mkEventVariants "escape") + onEnterC :: (Text -> Continuation m a) -> (Text, Prop m a) onEnterC f = listenRaw "keyup" $ \(RawNode n) _ -> liftJSM $ f <$> (valToText =<< unsafeGetProp "value"
Shpadoinkle/Html/Event/Basic.hs view
@@ -26,7 +26,7 @@ -- @(Text -> a -> a)@ where 'Text' is the current value of the input and 'onKeyup' takes -- a function of type @(KeyCode -> a -> a)@ from 'Shpadoinkle.Keyboard'. Mouse move -- listeners, for example, should take a function of @((Float, Float) -> a -> a)@, but--- this work is not yet done. See https://gitlab.com/fresheyeball/Shpadoinkle/issues/5+-- this work is not yet done. See https://gitlab.com/platonic/shpadoinkle/issues/5 module Shpadoinkle.Html.Event.Basic where
Shpadoinkle/Html/Event/Debounce.hs view
@@ -5,8 +5,7 @@ module Shpadoinkle.Html.Event.Debounce ( debounce , debounceRaw- , Debounce- , runDebounce+ , Debounce (..) ) where
Shpadoinkle/Html/Property.hs view
@@ -5,7 +5,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | This module provides a DSL for HTML properties@@ -37,11 +39,11 @@ -- | How do we take a non-textual value, and make it text which JavaScript will -- cast appropriately?-class ToPropText a where toPropText :: a -> Text-instance ToPropText Text where toPropText = id-instance ToPropText Int where toPropText = pack . show+class ToPropText a where toPropText :: a -> Text+instance ToPropText Text where toPropText = id+instance ToPropText Int where toPropText = pack . show instance ToPropText Float where toPropText = pack . show-instance ToPropText Bool where toPropText = \case True -> "true"; False -> "false"+instance ToPropText Bool where toPropText = \case True -> "true"; False -> "false" textProperty :: ToPropText a => Text -> a -> (Text, Prop m b)@@ -53,15 +55,17 @@ newtype ClassList = ClassList { unClassList :: Set.Set Text } deriving (Eq, Ord, Show, Semigroup, Monoid)-class ClassListRep a where asClass :: a -> ClassList-instance ClassListRep Text where asClass = ClassList . Set.fromList . split (== ' ')-instance ClassListRep ClassList where asClass = id-instance ClassListRep (Text, Bool) where asClass (a, b) = if b then asClass a else mempty-instance ClassListRep (ClassList, Bool) where asClass = \case (cl, True) -> cl; _ -> mempty-instance ClassListRep cl => ClassListRep [cl] where asClass = foldMap asClass instance IsString ClassList where fromString = ClassList . Set.fromList . split (== ' ') . pack +class ClassListRep a where asClass :: a -> ClassList+instance ClassListRep Text where asClass = ClassList . Set.fromList . split (== ' ')+instance ClassListRep ClassList where asClass = id+instance ClassListRep (Text, Bool) where asClass (a, b) = if b then asClass a else mempty+instance ClassListRep (ClassList, Bool) where asClass = \case (cl, True) -> cl; _ -> mempty+instance ClassListRep cl => ClassListRep [cl] where asClass = foldMap asClass++ flagProperty :: Text -> Bool -> (Text, Prop m a) flagProperty t = (,) t . flagProp @@ -78,6 +82,17 @@ for' = textProperty "htmlFor" +styleProp :: [(Text, Text)] -> (Text, Prop m a)+styleProp = textProperty "style" . intercalate ";" . fmap subStyle+ where subStyle (k,v) = k <> ":" <> v+++px, toEm, rem :: (Num a, Show a) => a -> Text+px = (<> "px") . pack . show+toEm = (<> "em") . pack . show+rem = (<> "rem") . pack . show++ $(msum <$> mapM mkBoolProp [ "checked", "selected", "hidden", "autocomplete", "autofocus", "disabled", "autoplay", "controls", "loop" , "multiple", "novalidate", "readonly", "required", "ismap", "usemap", "default'", "reversed"@@ -89,11 +104,15 @@ , "max", "min", "step", "wrap", "target", "download", "hreflang", "media", "ping", "shape", "coords" , "alt", "preload", "poster", "name'", "kind'", "srclang", "sandbox", "srcdoc", "align" , "headers", "scope", "datetime", "pubdate", "manifest", "contextmenu", "draggable"- , "dropzone", "itemprop", "charset", "content", "property", "innerHTML"+ , "dropzone", "itemprop", "charset", "content", "property", "innerHTML", "lang" ]) $(msum <$> mapM mkIntProp- [ "tabIndex", "width", "height" ])+ [ "tabIndex", "width", "height", "maxLength", "minLength" ])+++newTab :: (Text, Prop m a)+newTab = target "_blank" tabbable :: (Text, Prop m a)
+ Shpadoinkle/Html/TH/AssetLink.hs view
@@ -0,0 +1,27 @@+module Shpadoinkle.Html.TH.AssetLink where+++import Control.Monad (unless)+import Language.Haskell.TH.Syntax (Exp (LitE), Lit (StringL), Q,+ runIO)+import Prelude hiding (readFile)+import System.Directory (doesFileExist)+import System.Exit (ExitCode (..))+import System.Process (readProcessWithExitCode)+++assetLink :: FilePath -> Q Exp+assetLink = assetLinkWithBase ""+++assetLinkWithBase :: FilePath -> FilePath -> Q Exp+assetLinkWithBase base fp' = runIO $ do+ let fp = base <> fp'++ exists <- doesFileExist $ "." <> fp+ unless exists . fail $ "No asset found at " <> fp++ out@(exit, hash, _) <- readProcessWithExitCode "sha1sum" ["." <> fp] ""+ case exit of+ ExitSuccess -> return . LitE . StringL $ fp <> "?_=" <> take 20 hash+ ExitFailure _ -> fail $ show out
Shpadoinkle/Html/TH/CSS.hs view
@@ -18,6 +18,7 @@ import Control.Compactable import Data.ByteString.Lazy as BS (ByteString) import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Char (toLower) import Data.Containers.ListUtils (nubOrd) import qualified Data.Set as Set import Data.String (IsString)@@ -108,12 +109,17 @@ sanitize :: String -> String-sanitize = (=<<) $ \case+sanitize = lowerFirst . (=<<) (\case '/' -> "''" '-' -> "_" ':' -> "'" '>' -> "GT"- x -> pure x+ x -> pure x)+++lowerFirst :: String -> String+lowerFirst (x:xs) = toLower x : xs+lowerFirst x = x selectors :: IsString s => s
Shpadoinkle/Html/TH/CSSTest.hs view
@@ -8,6 +8,7 @@ , bar , foo , txt_rt+ , woah ) where
+ sample.css view
@@ -0,0 +1,22 @@+.txt-rt, span.foo{+ text-align:right;+}++.pos-relative{+ position:relative;+}++#foo[type="bar"]{+ background: #123233;+}++.Woah {+ height: auto;+}++@media print (min-width:200px){+ .bar{+ width: #EFEFEF;+ content: '.qux and #stuff';+ }+}