diff --git a/guide.cabal b/guide.cabal index 48a80bf..554a705 100644 --- a/guide.cabal +++ b/guide.cabal @@ -94,6 +94,7 @@ library , feed >= 0.3.11 && < 0.4 , filemanip == 0.3.6.* , filepath + , fmt == 0.0.0.4 , focus , friendly-time == 0.4.* , fsnotify == 0.2.* diff --git a/src/Guide/Handlers.hs b/src/Guide/Handlers.hs index a8d6360..bb25b89 100644 --- a/src/Guide/Handlers.hs +++ b/src/Guide/Handlers.hs @@ -422,7 +422,7 @@ itemToFeedEntry baseUrl category item = do Atom.entryContent = Just (Atom.HTMLContent (TL.unpack entryContent)) } where entryLink = baseUrl // - T.format "{}#item-{}" (categorySlug category, item^.uid) + format "{}#item-{}" (categorySlug category, item^.uid) entryBase = Atom.nullEntry (T.unpack (uidToText (item^.uid))) (Atom.TextString (T.unpack (item^.name))) diff --git a/src/Guide/JS.hs b/src/Guide/JS.hs index 6d0b4d0..90c27b1 100644 --- a/src/Guide/JS.hs +++ b/src/Guide/JS.hs @@ -121,20 +121,22 @@ class JSFunction a where -- This generates function definition instance JSFunction JS where makeJSFunction fName fParams fDef = - JS $ T.format "function {}({}) {\n{}}\n" - (fName, T.intercalate "," fParams, fDef) + let paramList = T.intercalate "," fParams + in JS $ "function "%%"("%%") {\n" + %% + "}\n" -- This generates a function that takes arguments and produces a Javascript -- function call instance JSParams a => JSFunction (a -> JS) where makeJSFunction fName _fParams _fDef = \args -> - JS $ T.format "{}({});" - (fName, T.intercalate "," (map fromJS (jsParams args))) + let paramList = T.intercalate "," (map fromJS (jsParams args)) + in JS $ ""%%"("%%");" -- This isn't a standalone function and so it doesn't have to be listed in -- 'allJSFunctions'. assign :: ToJS x => JS -> x -> JS -assign v x = JS $ T.format "{} = {};" (v, toJS x) +assign v x = JS $ format "{} = {};" (v, toJS x) -- TODO: all links here shouldn't be absolute [absolute-links] @@ -708,19 +710,20 @@ newtype JQuerySelector = JQuerySelector Text deriving (ToJS, T.Buildable) selectId :: Text -> JQuerySelector -selectId x = JQuerySelector $ T.format "#{}" [x] +selectId x = JQuerySelector $ format "#{}" [x] selectUid :: Uid Node -> JQuerySelector -selectUid x = JQuerySelector $ T.format "#{}" [x] +selectUid x = JQuerySelector $ format "#{}" [x] selectClass :: Text -> JQuerySelector -selectClass x = JQuerySelector $ T.format ".{}" [x] +selectClass x = JQuerySelector $ format ".{}" [x] selectParent :: JQuerySelector -> JQuerySelector -selectParent x = JQuerySelector $ T.format ":has(> {})" [x] +selectParent x = JQuerySelector $ format ":has(> {})" [x] selectChildren :: JQuerySelector -> JQuerySelector -> JQuerySelector -selectChildren a b = JQuerySelector $ T.format "{} > {}" (a, b) +selectChildren a b = JQuerySelector $ format "{} > {}" (a, b) selectSection :: JQuerySelector -> Text -> JQuerySelector -selectSection a b = JQuerySelector $ T.format "{} > .section.{}" (a, b) +selectSection a b = JQuerySelector $ format "{} > .section.{}" (a, b) + diff --git a/src/Guide/Types/Core.hs b/src/Guide/Types/Core.hs index c47f0e4..8074ca6 100644 --- a/src/Guide/Types/Core.hs +++ b/src/Guide/Types/Core.hs @@ -260,7 +260,7 @@ instance A.ToJSON Category where categorySlug :: Category -> Text categorySlug category = - T.format "{}-{}" (makeSlug (category^.title), category^.uid) + format "{}-{}" (makeSlug (category^.title), category^.uid) ---------------------------------------------------------------------------- -- Utils diff --git a/src/Guide/Views.hs b/src/Guide/Views.hs index e6073aa..f157fbb 100644 --- a/src/Guide/Views.hs +++ b/src/Guide/Views.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} @@ -311,8 +312,8 @@ renderEdits globalState edits = do -- Unlike 'groupWith', “groupBy . equating” doesn't sort the input. let editBlocks = groupBy (equating getIP) edits let ipNum = length $ groupWith getIP edits - h1_ $ toHtml $ - T.format "Pending edits (IPs: {}, blocks: {})" (ipNum, length editBlocks) + h1_ $ toHtml @Text $ + "Pending edits (IPs: "%%", blocks: "%%")" for_ editBlocks $ \editBlock -> div_ $ do blockNode <- thisNode h2_ $ do diff --git a/src/Guide/Views/Utils.hs b/src/Guide/Views/Utils.hs index d85b12d..c1aeb88 100644 --- a/src/Guide/Views/Utils.hs +++ b/src/Guide/Views/Utils.hs @@ -95,7 +95,8 @@ import Guide.Markdown -- | Add a script that does something on page load. onPageLoad :: Monad m => JS -> HtmlT m () -onPageLoad js = script_ $ T.format "$(document).ready(function(){{}});" [js] +onPageLoad js = script_ $ + "$(document).ready(function(){"%%"});" -- | Add some empty space. emptySpan :: Monad m => Text -> HtmlT m () @@ -104,19 +105,19 @@ emptySpan w = span_ [style_ ("margin-left:" <> w)] mempty -- Use inputValue to get the value (works with input_ and textarea_) onEnter :: JS -> Attribute onEnter handler = onkeydown_ $ - T.format "if (event.keyCode == 13 || event.keyCode == 10)\ - \ {{} return false;}\n" [handler] + "if (event.keyCode == 13 || event.keyCode == 10) {" + %%" return false;}\n" onCtrlEnter :: JS -> Attribute onCtrlEnter handler = onkeydown_ $ - T.format "if ((event.keyCode == 13 || event.keyCode == 10) &&\ - \ (event.metaKey || event.ctrlKey))\ - \ {{} return false;}\n" [handler] + "if ((event.keyCode == 13 || event.keyCode == 10) && " <> + "(event.metaKey || event.ctrlKey)) {" + %%" return false;}\n" onEscape :: JS -> Attribute onEscape handler = onkeydown_ $ - T.format "if (event.keyCode == 27)\ - \ {{} return false;}\n" [handler] + "if (event.keyCode == 27) {" + %%" return false;}\n" textInput :: Monad m => [Attribute] -> HtmlT m () textInput attrs = input_ (type_ "text" : attrs) @@ -128,7 +129,7 @@ clearInput :: JS clearInput = JS "this.value = '';" onFormSubmit :: (JS -> JS) -> Attribute -onFormSubmit f = onsubmit_ $ T.format "{} return false;" [f (JS "this")] +onFormSubmit f = onsubmit_ $ format "{} return false;" [f (JS "this")] button :: Monad m => Text -> [Attribute] -> JS -> HtmlT m () button value attrs handler = @@ -177,7 +178,7 @@ markdownEditor -> HtmlT m () markdownEditor attr (view mdText -> s) submit cancel instr = do textareaUid <- randomLongUid - let val = JS $ T.format "document.getElementById(\"{}\").value" [textareaUid] + let val = JS $ "document.getElementById(\""%%"\").value" -- Autocomplete has to be turned off thanks to -- . textarea_ ([uid_ textareaUid, @@ -196,7 +197,8 @@ markdownEditor attr (view mdText -> s) submit cancel instr = do emptySpan "6px" span_ [class_ "edit-field-instruction"] (toHtml instr) a_ [href_ "/markdown", target_ "_blank"] $ - img_ [src_ "/markdown.svg", alt_ "markdown supported", class_ " markdown-supported "] + img_ [src_ "/markdown.svg", alt_ "markdown supported", + class_ " markdown-supported "] smallMarkdownEditor :: MonadIO m @@ -208,7 +210,7 @@ smallMarkdownEditor -> HtmlT m () smallMarkdownEditor attr (view mdText -> s) submit mbCancel instr = do textareaId <- randomLongUid - let val = JS $ T.format "document.getElementById(\"{}\").value" [textareaId] + let val = JS $ "document.getElementById(\""%%"\").value" textarea_ ([class_ "fullwidth", uid_ textareaId, autocomplete_ "off"] ++ [onEnter (submit val)] ++ [onEscape cancel | Just cancel <- [mbCancel]] ++ @@ -222,7 +224,8 @@ smallMarkdownEditor attr (view mdText -> s) submit mbCancel instr = do span_ [style_ "float:right"] $ do span_ [class_ "edit-field-instruction"] (toHtml instr) a_ [href_ "/markdown", target_ "_blank"] $ - img_ [src_ "/markdown.svg", alt_ "markdown supported", class_ " markdown-supported "] + img_ [src_ "/markdown.svg", alt_ "markdown supported", + class_ " markdown-supported "] thisNode :: MonadIO m => HtmlT m JQuerySelector thisNode = do @@ -233,18 +236,18 @@ thisNode = do return (JS.selectParent (JS.selectUid uid')) itemNodeId :: Item -> Text -itemNodeId item = "item-" <> uidToText (item^.uid) +itemNodeId item = format "item-{}" [item^.uid] categoryNodeId :: Category -> Text -categoryNodeId category = "category-" <> uidToText (category^.uid) +categoryNodeId category = format "category-{}" [category^.uid] -- TODO: another absolute link to get rid of [absolute-links] categoryLink :: Category -> Url -categoryLink category = "/haskell/" <> categorySlug category +categoryLink category = format "/haskell/{}" [categorySlug category] itemLink :: Category -> Item -> Url itemLink category item = - T.format "/haskell/{}#{}" (categorySlug category, itemNodeId item) + format "/haskell/{}#{}" (categorySlug category, itemNodeId item) -- See Note [show-hide]; wheh changing these, also look at 'JS.switchSection'. shown, noScriptShown :: Attribute diff --git a/src/Imports.hs b/src/Imports.hs index e7e2f73..45869ee 100644 --- a/src/Imports.hs +++ b/src/Imports.hs @@ -38,6 +38,8 @@ import Control.DeepSeq as X import Data.Hashable as X -- Lazy bytestring import qualified Data.ByteString.Lazy as BSL +-- Formatting +import Fmt as X type LByteString = BSL.ByteString diff --git a/stack.yaml b/stack.yaml index 51f281f..27f6e43 100644 --- a/stack.yaml +++ b/stack.yaml @@ -12,3 +12,4 @@ extra-deps: - http-client-0.5.1 - edit-distance-vector-1.0.0.4 - patches-vector-0.1.5.4 +- fmt-0.0.0.4