From 6fb6c1f634ac385d8ae5a7a521979dec6d0ad69e Mon Sep 17 00:00:00 2001 From: Joseph Morag Date: Sun, 21 Jun 2020 15:10:41 -0400 Subject: [PATCH 1/5] Ignore dist-newstyle --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index ea512f3..0b241e9 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ dist +dist-newstyle *.swp *.o *.hi From b27138b01e87a31ddf2b128d631e45b103e2db12 Mon Sep 17 00:00:00 2001 From: Joseph Morag Date: Tue, 23 Jun 2020 14:06:26 -0400 Subject: [PATCH 2/5] Add JavascriptModule newtypes and associated quasiQuoters --- Text/Julius.hs | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/Text/Julius.hs b/Text/Julius.hs index b6cc0d1..35eaa25 100644 --- a/Text/Julius.hs +++ b/Text/Julius.hs @@ -24,9 +24,18 @@ module Text.Julius , juliusFileReload , jsFileReload + , jsModule + , juliusModule + , juliusModuleFile + , jsModuleFile + , juliusModuleFileReload + , jsModuleFileReload + -- * Datatypes , JavascriptUrl + , JavascriptModuleUrl , Javascript (..) + , JavascriptModule (..) , RawJavascript (..) -- * Typeclass for interpolated variables @@ -95,6 +104,27 @@ instance ToJavascript String where toJavascript = toJavascript . toJSON instance ToJavascript TS.Text where toJavascript = toJavascript . toJSON instance ToJavascript TL.Text where toJavascript = toJavascript . toJSON +newtype JavascriptModule = JavascriptModule { unModule :: Javascript } + deriving (Semigroup, Monoid) + +type JavascriptModuleUrl url = + (url -> [(TS.Text, TS.Text)] -> TS.Text) -> JavascriptModule + +class ToJavascriptModule a where + toJavascriptModule :: a -> JavascriptModule + +instance ToJavascriptModule Bool where + toJavascriptModule = + JavascriptModule . Javascript . fromText . TS.toLower . TS.pack . show +instance ToJavascriptModule Value where + toJavascriptModule = JavascriptModule . Javascript . encodeToTextBuilder +instance ToJavascriptModule String where + toJavascriptModule = toJavascriptModule . toJSON +instance ToJavascriptModule TS.Text where + toJavascriptModule = toJavascriptModule . toJSON +instance ToJavascriptModule TL.Text where + toJavascriptModule = toJavascriptModule . toJSON + -- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be -- embedded efficiently in a text-based protocol. -- @@ -162,6 +192,8 @@ fromScientific s = formatScientificBuilder format prec s newtype RawJavascript = RawJavascript Builder instance ToJavascript RawJavascript where toJavascript (RawJavascript a) = Javascript a +instance ToJavascriptModule RawJavascript where + toJavascriptModule (RawJavascript a) = JavascriptModule (Javascript a) class RawJS a where rawJS :: a -> RawJavascript @@ -207,6 +239,41 @@ jsFileReload fp = do juliusFileReload = jsFileReload +javascriptModuleSettings :: Q ShakespeareSettings +javascriptModuleSettings = do + toJExp <- [|toJavascriptModule|] + wrapExp <- [|JavascriptModule|] + unWrapExp <- [|unModule|] + asJavascriptUrl' <- [|id :: JavascriptModuleUrl a -> JavascriptModuleUrl a|] + return $ defaultShakespeareSettings { toBuilder = toJExp + , wrap = wrapExp + , unwrap = unWrapExp + , modifyFinalValue = Just asJavascriptUrl' + } + +jsModule, juliusModule :: QuasiQuoter +jsModule = QuasiQuoter { quoteExp = \s -> do + rs <- javascriptModuleSettings + quoteExp (shakespeare rs) s + } + +juliusModule = jsModule + +jsModuleFile, juliusModuleFile :: FilePath -> Q Exp +jsModuleFile fp = do + rs <- javascriptModuleSettings + shakespeareFile rs fp + +juliusModuleFile = jsModuleFile + + +jsModuleFileReload, juliusModuleFileReload :: FilePath -> Q Exp +jsModuleFileReload fp = do + rs <- javascriptModuleSettings + shakespeareFileReload rs fp + +juliusModuleFileReload = jsModuleFileReload + jsFileDebug, juliusFileDebug :: FilePath -> Q Exp juliusFileDebug = jsFileReload {-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-} From 4f501d8222b674440e7b928ca438207445a47249 Mon Sep 17 00:00:00 2001 From: Joseph Morag Date: Tue, 23 Jun 2020 15:05:04 -0400 Subject: [PATCH 3/5] Make JavascriptModule a newtype over Builder instead of Javascript --- Text/Julius.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/Text/Julius.hs b/Text/Julius.hs index 35eaa25..e61343c 100644 --- a/Text/Julius.hs +++ b/Text/Julius.hs @@ -45,6 +45,8 @@ module Text.Julius -- ** Rendering Functions , renderJavascript , renderJavascriptUrl + , renderJavascriptModule + , renderJavascriptModuleUrl -- ** internal, used by 'Text.Coffee' , javascriptSettings @@ -104,20 +106,25 @@ instance ToJavascript String where toJavascript = toJavascript . toJSON instance ToJavascript TS.Text where toJavascript = toJavascript . toJSON instance ToJavascript TL.Text where toJavascript = toJavascript . toJSON -newtype JavascriptModule = JavascriptModule { unModule :: Javascript } +newtype JavascriptModule = JavascriptModule { unJavascriptModule :: Builder } deriving (Semigroup, Monoid) type JavascriptModuleUrl url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> JavascriptModule +renderJavascriptModule :: JavascriptModule -> TL.Text +renderJavascriptModule = toLazyText . unJavascriptModule + +renderJavascriptModuleUrl :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> JavascriptModuleUrl url -> TL.Text +renderJavascriptModuleUrl r s = renderJavascriptModule $ s r + class ToJavascriptModule a where toJavascriptModule :: a -> JavascriptModule instance ToJavascriptModule Bool where - toJavascriptModule = - JavascriptModule . Javascript . fromText . TS.toLower . TS.pack . show + toJavascriptModule = JavascriptModule . fromText . TS.toLower . TS.pack . show instance ToJavascriptModule Value where - toJavascriptModule = JavascriptModule . Javascript . encodeToTextBuilder + toJavascriptModule = JavascriptModule . encodeToTextBuilder instance ToJavascriptModule String where toJavascriptModule = toJavascriptModule . toJSON instance ToJavascriptModule TS.Text where @@ -193,7 +200,7 @@ newtype RawJavascript = RawJavascript Builder instance ToJavascript RawJavascript where toJavascript (RawJavascript a) = Javascript a instance ToJavascriptModule RawJavascript where - toJavascriptModule (RawJavascript a) = JavascriptModule (Javascript a) + toJavascriptModule (RawJavascript a) = JavascriptModule a class RawJS a where rawJS :: a -> RawJavascript @@ -243,7 +250,7 @@ javascriptModuleSettings :: Q ShakespeareSettings javascriptModuleSettings = do toJExp <- [|toJavascriptModule|] wrapExp <- [|JavascriptModule|] - unWrapExp <- [|unModule|] + unWrapExp <- [|unJavascriptModule|] asJavascriptUrl' <- [|id :: JavascriptModuleUrl a -> JavascriptModuleUrl a|] return $ defaultShakespeareSettings { toBuilder = toJExp , wrap = wrapExp From b5b755067c1aadae01fc25bca5417c630883078c Mon Sep 17 00:00:00 2001 From: Joseph Morag Date: Tue, 23 Jun 2020 22:05:53 -0400 Subject: [PATCH 4/5] Uninline id in quasiquoter --- Text/Julius.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Text/Julius.hs b/Text/Julius.hs index e61343c..174169a 100644 --- a/Text/Julius.hs +++ b/Text/Julius.hs @@ -112,6 +112,9 @@ newtype JavascriptModule = JavascriptModule { unJavascriptModule :: Builder } type JavascriptModuleUrl url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> JavascriptModule +asJavascriptModuleUrl :: JavascriptModuleUrl url -> JavascriptModuleUrl url +asJavascriptModuleUrl = id + renderJavascriptModule :: JavascriptModule -> TL.Text renderJavascriptModule = toLazyText . unJavascriptModule @@ -251,7 +254,7 @@ javascriptModuleSettings = do toJExp <- [|toJavascriptModule|] wrapExp <- [|JavascriptModule|] unWrapExp <- [|unJavascriptModule|] - asJavascriptUrl' <- [|id :: JavascriptModuleUrl a -> JavascriptModuleUrl a|] + asJavascriptUrl' <- [|asJavascriptModuleUrl|] return $ defaultShakespeareSettings { toBuilder = toJExp , wrap = wrapExp , unwrap = unWrapExp From 6e2ec3dc79e81a04436c3e6f398bc353dd50ff9a Mon Sep 17 00:00:00 2001 From: Joseph Morag Date: Mon, 29 Jun 2020 15:46:51 -0400 Subject: [PATCH 5/5] Add jsModule quasiquoters and widgetFile --- Text/Julius.hs | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/Text/Julius.hs b/Text/Julius.hs index b6cc0d1..6b2904f 100644 --- a/Text/Julius.hs +++ b/Text/Julius.hs @@ -19,6 +19,10 @@ module Text.Julius , julius , juliusFile , jsFile + , jsModule + , juliusModule + , juliusModuleFile + , jsModuleFile , juliusFileDebug , jsFileDebug , juliusFileReload @@ -52,6 +56,8 @@ import Data.Semigroup (Semigroup(..)) import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import Text.Shakespeare +import Text.Hamlet (HtmlUrl) +import Text.Blaze.Html (preEscapedToHtml) import Data.Aeson (Value, toJSON) import Data.Aeson.Types (Value(..)) import Numeric (showHex) @@ -184,7 +190,17 @@ javascriptSettings = do , modifyFinalValue = Just asJavascriptUrl' } -js, julius :: QuasiQuoter +asJsModuleUrl :: JavascriptUrl url -> HtmlUrl url +asJsModuleUrl = fmap + (\j -> preEscapedToHtml $ "") + +jsModuleSettings :: Q ShakespeareSettings +jsModuleSettings = do + settings <- javascriptSettings + asUrl' <- [|asJsModuleUrl|] + return $ settings { modifyFinalValue = Just asUrl' } + +js, julius, jsModule, juliusModule :: QuasiQuoter js = QuasiQuoter { quoteExp = \s -> do rs <- javascriptSettings quoteExp (shakespeare rs) s @@ -192,13 +208,26 @@ js = QuasiQuoter { quoteExp = \s -> do julius = js -jsFile, juliusFile :: FilePath -> Q Exp +jsModule = QuasiQuoter { quoteExp = \s -> do + rs <- jsModuleSettings + quoteExp (shakespeare rs) s + } + +juliusModule = jsModule + +jsFile, juliusFile, jsModuleFile, juliusModuleFile :: FilePath -> Q Exp jsFile fp = do rs <- javascriptSettings shakespeareFile rs fp juliusFile = jsFile +jsModuleFile fp = do + rs <- jsModuleSettings + shakespeareFile rs fp + +juliusModuleFile = jsFile + jsFileReload, juliusFileReload :: FilePath -> Q Exp jsFileReload fp = do