@@ -1,93 +1,96 @@
1−{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
1+{-# LANGUAGE TemplateHaskell #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE CPP #-}
25{-# OPTIONS_GHC -fno-warn-missing-fields #-}
36
4−module Language.Elm.Quasi (elm, elmFile) where
5−
6−import Language.Haskell.TH.Quote
7−import Language.Haskell.TH
8−import Language.Haskell.Meta (parseExp)
9−
10−import Data.Attoparsec.Text
11−import Data.Text as T (Text, pack, unpack, strip)
12−
13−{- | This QuasiQuoter allows for literal embedding of elm source code within
14− Haskell files. It is not responsible for the actual compilation Process.
15− Usage:
16−
17− @
18− elmPage = [elm|
19− main = image \"someImage.jpg\"
20− |]
21− @
22−
23− It also allows for simple variable interpolation using the ^{...} syntax.
24− This is intended for e.g. embedding pre-rendered type-safe URLs.
25− All interpolated variables must be a member of the Show typeclass. This
26− is not tested with more complicated expressions, so it is recommended to
27− restrict usage of interpolation to pre-calculated variables.
28−
29− Example:
30−
31− > let google = "http://google.com"
32− > in [elm|
33− > main = text $ link ^{google} (toText "Google")
34− > |]
35−
36−
37− How the elm code is compiled depends on how you intend to use it.
38− Example uses are the included 'generateHtml' function as well as the
39− "Language.Elm.Yesod" module.
40−-}
41−elm :: QuasiQuoter
42−elm = QuasiQuoter
43− { quoteExp = \s ->
44− let chunks = flip map (getQChunks s) $ \c ->
45− case c of
46− S t -> [| t |]
47− E t -> let Right e = parseExp t in appE [| show |] (return e)
48− in appE [| concat |] (listE chunks)
7+-- | This module contains Shakespearean (see "Text.Shakespeare") templates for Elm.
8+-- It introduces type-safe compile-time variable and URL interpolation. A typeclass
9+-- 'ToElm' is provided for interpolated variables.
10+--
11+-- Further reading on Shakespearean templates: <http://www.yesodweb.com/book/templates>
12+--
13+-- Further reading on Elm: <http://elm-lang.org>
14+module Language.Elm.Quasi
15+ ( -- * Functions
16+ -- ** Template-Reading Functions
17+ -- | These QuasiQuoter and Template Haskell methods return values of
18+ -- type @'ElmUrl' url@. See the Yesod book for details.
19+ elm
20+ , elmFile
21+ , elmFileReload
22+
23+ -- * Datatypes
24+ , ElmUrl
25+ , Elm (..)
26+
27+ -- * Typeclass for interpolated variables
28+ , ToElm (..)
29+
30+ -- ** Rendering Functions
31+ , renderElm
32+ , renderElmUrl
33+
34+ ) where
35+
36+import Language.Haskell.TH.Quote (QuasiQuoter (..))
37+import Language.Haskell.TH.Syntax
38+import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText)
39+import Data.Monoid
40+import qualified Data.Text as TS
41+import qualified Data.Text.Lazy as TL
42+import Text.Shakespeare
43+
44+-- | Render Elm to lazy Text without route interpolation.
45+renderElm :: Elm -> TL.Text
46+renderElm (Elm b) = toLazyText b
47+
48+-- | render with route interpolation. If using this module standalone, apart
49+-- from type-safe routes, a dummy renderer can be used:
50+--
51+-- > renderElmUrl (\_ _ -> undefined) elmUrl
52+--
53+-- When using Yesod, a renderer is generated for you, which can be accessed
54+-- within the GHandler monad: 'Yesod.Handler.getUrlRenderParams'.
55+renderElmUrl :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> ElmUrl url -> TL.Text
56+renderElmUrl r s = renderElm $ s r
57+
58+-- | Newtype wrapper of 'Builder'.
59+newtype Elm = Elm { unElm :: Builder }
60+ deriving Monoid
61+
62+-- | Return type of template-reading functions.
63+type ElmUrl url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Elm
64+
65+-- | A typeclass for types that can be interpolated in CoffeeScript templates.
66+class ToElm a where
67+ toElm :: a -> Builder
68+instance ToElm [Char] where toElm = fromLazyText . TL.pack
69+instance ToElm TS.Text where toElm = fromText
70+instance ToElm TL.Text where toElm = fromLazyText
71+
72+elmSettings :: Q ShakespeareSettings
73+elmSettings = do
74+ toJExp <- [|toElm|]
75+ wrapExp <- [|Elm|]
76+ unWrapExp <- [|unElm|]
77+ return $ defaultShakespeareSettings { toBuilder = toJExp
78+ , wrap = wrapExp
79+ , unwrap = unWrapExp
4980 }
5081
51−{- | elmFile is a quoteFile wrapper around the 'elm' QuasiQuoter and allows for
52− external elm source files to be embedded.
53− Usage:
54−
55− @
56− [elmFile|elm-source/page.elm|]
57− @
58−
59− Please note that no spaces should be added before and after the filename.
60−-}
61−elmFile :: QuasiQuoter
62−elmFile = quoteFile elm
63−
64−data QChunk =
65− S String -- ^ A literal string
66− | E String -- ^ An expression (must be of the Show typeclass)
67− deriving (Show, Eq)
68−
69−
70−{- thanks to mikeplus64 for providing an example QuasiQuoter that I could look at while writing this :) -}
71−getQChunks :: String -> [QChunk]
72−getQChunks si = let i = T.pack si
73− Right m = parseOnly parser (strip i) in m
74− where
75− parser = go []
76−
77− go s = do
78− txt <- takeTill (== '^')
79− evt <- choice [expression, fmap (S . T.unpack) takeText]
80− end <- atEnd
81− if end
82− then return $ filter (not . blank) $ reverse (evt:(S . T.unpack) txt:s)
83− else go (evt:(S . T.unpack) txt:s)
84−
85− blank (S "") = True
86− blank (E "") = True
87− blank _ = False
88−
89− expression = do
90− string "^{"
91− expr <- takeTill (== '}')
92− char '}'
93− return $ (E . T.unpack) expr
82+elm :: QuasiQuoter
83+elm = QuasiQuoter { quoteExp = \s -> do
84+ rs <- elmSettings
85+ quoteExp (shakespeare rs) s
86+ }
87+
88+elmFile :: FilePath -> Q Exp
89+elmFile fp = do
90+ rs <- elmSettings
91+ shakespeareFile rs fp
92+
93+elmFileReload :: FilePath -> Q Exp
94+elmFileReload fp = do
95+ rs <- elmSettings
96+ shakespeareFileReload rs fp