diff --git a/.gitignore b/.gitignore index e849773..e268c2d 100644 --- a/.gitignore +++ b/.gitignore @@ -26,6 +26,8 @@ config.json # IDE/support .idea/ +.ideaHaskellLib/ +guide.iml .vscode/ tags diff --git a/src/Guide/JS.hs b/src/Guide/JS.hs index 6988661..6873128 100644 --- a/src/Guide/JS.hs +++ b/src/Guide/JS.hs @@ -122,8 +122,8 @@ class JSFunction a where instance JSFunction JS where makeJSFunction fName fParams fDef = let paramList = T.intercalate "," fParams - in JS $ format "function "#|fName|#"("#|paramList|#") {\n" - #|indent 2 (build fDef)|# + in JS $ format "function "+|fName|+"("+|paramList|+") {\n" + +|indent 2 (build fDef)|+ "}\n" -- This generates a function that takes arguments and produces a Javascript diff --git a/src/Guide/Views.hs b/src/Guide/Views.hs index fbfefe4..47874c5 100644 --- a/src/Guide/Views.hs +++ b/src/Guide/Views.hs @@ -327,7 +327,7 @@ renderEdits globalState edits = do let editBlocks = groupBy (equating getIP) edits let ipNum = length $ groupWith getIP edits h1_ $ toHtml @Text $ - "Pending edits (IPs: "#|ipNum|#", blocks: "#|length editBlocks|#")" + "Pending edits (IPs: "+|ipNum|+", blocks: "+|length editBlocks|+")" for_ editBlocks $ \editBlock -> div_ $ do blockNode <- thisNode h2_ $ do @@ -831,7 +831,7 @@ renderAdminLinks globalState = do print (lnk, status) pure $ case status of Status 200 _ -> OK - Status code err -> Broken (""#|code|#": "#||err||#"") + Status code err -> Broken (""+|code|+": "+||err||+"") ) `catch` (return . handleHttpException) else pure Unparseable diff --git a/src/Guide/Views/Utils.hs b/src/Guide/Views/Utils.hs index 4bb4459..16462c1 100644 --- a/src/Guide/Views/Utils.hs +++ b/src/Guide/Views/Utils.hs @@ -109,7 +109,7 @@ import Guide.Views.Utils.Input -- | Add a script that does something on page load. onPageLoad :: Monad m => JS -> HtmlT m () onPageLoad js = script_ $ - "$(document).ready(function(){"#|js|#"});" + "$(document).ready(function(){"+|js|+"});" -- | Add some empty space. emptySpan :: Monad m => Text -> HtmlT m () @@ -119,18 +119,18 @@ emptySpan w = span_ [style_ ("margin-left:" <> w)] mempty onEnter :: JS -> Attribute onEnter handler = onkeydown_ $ "if (event.keyCode == 13 || event.keyCode == 10) {" - #|handler|#" return false;}\n" + +|handler|+" return false;}\n" onCtrlEnter :: JS -> Attribute onCtrlEnter handler = onkeydown_ $ "if ((event.keyCode == 13 || event.keyCode == 10) && " <> "(event.metaKey || event.ctrlKey)) {" - #|handler|#" return false;}\n" + +|handler|+" return false;}\n" onEscape :: JS -> Attribute onEscape handler = onkeydown_ $ "if (event.keyCode == 27) {" - #|handler|#" return false;}\n" + +|handler|+" return false;}\n" textInput :: Monad m => [Attribute] -> HtmlT m () textInput attrs = input_ (type_ "text" : attrs) @@ -191,7 +191,7 @@ markdownEditor -> HtmlT m () markdownEditor attr (view mdText -> s) submit cancel instr = do textareaUid <- randomLongUid - let val = JS $ "document.getElementById(\""#|textareaUid|#"\").value" + let val = JS $ "document.getElementById(\""+|textareaUid|+"\").value" -- Autocomplete has to be turned off thanks to -- . textarea_ ([uid_ textareaUid, @@ -223,7 +223,7 @@ smallMarkdownEditor -> HtmlT m () smallMarkdownEditor attr (view mdText -> s) submit mbCancel instr = do textareaId <- randomLongUid - let val = JS $ "document.getElementById(\""#|textareaId|#"\").value" + let val = JS $ "document.getElementById(\""+|textareaId|+"\").value" textarea_ ([class_ "fullwidth", uid_ textareaId, autocomplete_ "off"] ++ [onEnter (submit val)] ++ [onEscape cancel | Just cancel <- [mbCancel]] ++ diff --git a/src/Imports.hs b/src/Imports.hs index 9217826..67992d7 100644 --- a/src/Imports.hs +++ b/src/Imports.hs @@ -9,39 +9,83 @@ module Imports ( module X, LByteString, + (+|), + (|+), + (+||), + (||+), + (|++|), + (||++||), + (|++||), + (||++|) ) where -import BasePrelude as X hiding (Category, GeneralCategory, lazy, (&)) +import BasePrelude as X hiding (Category, GeneralCategory, lazy, (&)) -- Lists -import Data.List.Index as X -import Data.List.Extra as X (takeEnd, dropEnd) +import Data.List.Extra as X (dropEnd, takeEnd) +import Data.List.Index as X -- Lenses -import Lens.Micro.Platform as X +import Lens.Micro.Platform as X -- Monads and monad transformers -import Control.Monad.IO.Class as X -import Control.Monad.State as X -import Control.Monad.Reader as X +import Control.Monad.IO.Class as X +import Control.Monad.Reader as X +import Control.Monad.State as X -- Common types -import Data.Text.All as X (Text, LText) -import Data.ByteString as X (ByteString) -import Data.Map as X (Map) -import Data.Set as X (Set) +import Data.ByteString as X (ByteString) +import Data.Map as X (Map) +import Data.Set as X (Set) +import Data.Text.All as X (LText, Text) -- Time -import Data.Time as X +import Data.Time as X -- Files -import System.Directory as X -import System.FilePath as X +import System.Directory as X +import System.FilePath as X -- Deepseq -import Control.DeepSeq as X +import Control.DeepSeq as X -- Hashable -import Data.Hashable as X +import Data.Hashable as X -- Lazy bytestring -import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Lazy as BSL -- Formatting -import Fmt as X +import Fmt as X hiding (( #| ), ( #|| ), (|#), (|##|), + (|##||), (||#), (||##|), (||##||)) +import qualified Fmt as FMT (( #| ), ( #|| ), (|#), (|##|), (|##||), + (||#), (||##|), (||##||)) +import Fmt.Internal (FromBuilder) type LByteString = BSL.ByteString -- LText is already provided by Data.Text.All + +infixr 1 +| +(+|) :: FromBuilder b => Builder -> Builder -> b +(+|) = (FMT.#|) + +infixr 1 |+ +(|+) :: (Buildable a, FromBuilder b) => a -> Builder -> b +(|+) = (FMT.|#) + +infixr 1 +|| +(+||) :: FromBuilder b => Builder -> Builder -> b +(+||) = (FMT.#||) + +infixr 1 ||+ +(||+) :: (Show a, FromBuilder b) => a -> Builder -> b +(||+) = (FMT.||#) + +infixr 1 |++| +(|++|) :: (Buildable a, FromBuilder b) => a -> Builder -> b +(|++|) = (FMT.|##|) + +infixr 1 ||++|| +(||++||) :: (Show a, FromBuilder b) => a -> Builder -> b +(||++||) = (FMT.||##||) + +infixr 1 ||++| +(|++||) :: (Show a, FromBuilder b) => a -> Builder -> b +(|++||) = (FMT.|##||) + +infixr 1 |++|| +(||++|) :: (Buildable a, FromBuilder b) => a -> Builder -> b +(||++|) = (FMT.||##|)