@@ -0,0 +1,93 @@
1+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
2+{-# OPTIONS_GHC -fno-warn-missing-fields #-}
3+
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)
49+ }
50+
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