diff --git a/CHANGELOG.md b/CHANGELOG.md deleted file mode 100644 --- a/CHANGELOG.md +++ /dev/null diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Shpadoinkle Html -[![Goldwater](https://gitlab.com/fresheyeball/Shpadoinkle/badges/master/pipeline.svg)](https://gitlab.com/fresheyeball/Shpadoinkle) +[![Goldwater](https://gitlab.com/platonic/shpadoinkle/badges/master/pipeline.svg)](https://gitlab.com/platonic/shpadoinkle) [![Haddock](https://img.shields.io/badge/haddock-master-informational)](https://shpadoinkle.org/html) [![BSD-3](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause) [![built with nix](https://img.shields.io/badge/built%20with-nix-41439a)](https://builtwithnix.org) @@ -8,54 +8,4 @@ [![Hackage Deps](https://img.shields.io/hackage-deps/v/Shpadoinkle-html.svg)](http://packdeps.haskellers.com/reverse/Shpadoinkle-html) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/Shpadoinkle-html/badge)](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) diff --git a/Shpadoinkle-html.cabal b/Shpadoinkle-html.cabal --- a/Shpadoinkle-html.cabal +++ b/Shpadoinkle-html.cabal @@ -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 diff --git a/Shpadoinkle/Html.hs b/Shpadoinkle/Html.hs --- a/Shpadoinkle/Html.hs +++ b/Shpadoinkle/Html.hs @@ -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 diff --git a/Shpadoinkle/Html/Event.hs b/Shpadoinkle/Html/Event.hs --- a/Shpadoinkle/Html/Event.hs +++ b/Shpadoinkle/Html/Event.hs @@ -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" diff --git a/Shpadoinkle/Html/Event/Basic.hs b/Shpadoinkle/Html/Event/Basic.hs --- a/Shpadoinkle/Html/Event/Basic.hs +++ b/Shpadoinkle/Html/Event/Basic.hs @@ -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 diff --git a/Shpadoinkle/Html/Event/Debounce.hs b/Shpadoinkle/Html/Event/Debounce.hs --- a/Shpadoinkle/Html/Event/Debounce.hs +++ b/Shpadoinkle/Html/Event/Debounce.hs @@ -5,8 +5,7 @@ module Shpadoinkle.Html.Event.Debounce ( debounce , debounceRaw - , Debounce - , runDebounce + , Debounce (..) ) where diff --git a/Shpadoinkle/Html/Property.hs b/Shpadoinkle/Html/Property.hs --- a/Shpadoinkle/Html/Property.hs +++ b/Shpadoinkle/Html/Property.hs @@ -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) diff --git a/Shpadoinkle/Html/TH/AssetLink.hs b/Shpadoinkle/Html/TH/AssetLink.hs new file mode 100644 --- /dev/null +++ b/Shpadoinkle/Html/TH/AssetLink.hs @@ -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 diff --git a/Shpadoinkle/Html/TH/CSS.hs b/Shpadoinkle/Html/TH/CSS.hs --- a/Shpadoinkle/Html/TH/CSS.hs +++ b/Shpadoinkle/Html/TH/CSS.hs @@ -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 diff --git a/Shpadoinkle/Html/TH/CSSTest.hs b/Shpadoinkle/Html/TH/CSSTest.hs --- a/Shpadoinkle/Html/TH/CSSTest.hs +++ b/Shpadoinkle/Html/TH/CSSTest.hs @@ -8,6 +8,7 @@ , bar , foo , txt_rt + , woah ) where diff --git a/sample.css b/sample.css new file mode 100644 --- /dev/null +++ b/sample.css @@ -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'; + } +}