mirror of
https://github.com/aelve/guide.git
synced 2024-12-23 12:52:31 +03:00
Switch to the fmt library for formatting
This commit is contained in:
parent
e13a7fc832
commit
4ff43808ee
@ -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.*
|
||||
|
@ -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)))
|
||||
|
@ -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 "%<fName>%"("%<paramList>%") {\n"
|
||||
%<indent 2 (build fDef)>%
|
||||
"}\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 $ ""%<fName>%"("%<paramList>%");"
|
||||
|
||||
-- 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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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: "%<ipNum>%", blocks: "%<length editBlocks>%")"
|
||||
for_ editBlocks $ \editBlock -> div_ $ do
|
||||
blockNode <- thisNode
|
||||
h2_ $ do
|
||||
|
@ -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(){"%<js>%"});"
|
||||
|
||||
-- | 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) {"
|
||||
%<handler>%" 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)) {"
|
||||
%<handler>%" return false;}\n"
|
||||
|
||||
onEscape :: JS -> Attribute
|
||||
onEscape handler = onkeydown_ $
|
||||
T.format "if (event.keyCode == 27)\
|
||||
\ {{} return false;}\n" [handler]
|
||||
"if (event.keyCode == 27) {"
|
||||
%<handler>%" 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(\""%<textareaUid>%"\").value"
|
||||
-- Autocomplete has to be turned off thanks to
|
||||
-- <http://stackoverflow.com/q/8311455>.
|
||||
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(\""%<textareaId>%"\").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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user