Skip to content
This repository
Browse code

Pin down types better in julius

  • Loading branch information...
commit 69d3a576286c0a972b8ca4ac2a386bbb3c1bef61 1 parent 35f3203
Michael Snoyman snoyberg authored
5 shakespeare-js/Text/Julius.hs
@@ -69,6 +69,9 @@ newtype Javascript = Javascript { unJavascript :: Builder }
69 69 -- | Return type of template-reading functions.
70 70 type JavascriptUrl url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Javascript
71 71
  72 +asJavascriptUrl :: JavascriptUrl url -> JavascriptUrl url
  73 +asJavascriptUrl = id
  74 +
72 75 -- | A typeclass for types that can be interpolated in CoffeeScript templates.
73 76 class ToJavascript a where
74 77 toJavascript :: a -> Builder
@@ -81,9 +84,11 @@ javascriptSettings = do
81 84 toJExp <- [|toJavascript|]
82 85 wrapExp <- [|Javascript|]
83 86 unWrapExp <- [|unJavascript|]
  87 + asJavascriptUrl' <- [|asJavascriptUrl|]
84 88 return $ defaultShakespeareSettings { toBuilder = toJExp
85 89 , wrap = wrapExp
86 90 , unwrap = unWrapExp
  91 + , modifyFinalValue = Just asJavascriptUrl'
87 92 }
88 93
89 94 js, julius :: QuasiQuoter
4 shakespeare-js/shakespeare-js.cabal
... ... @@ -1,5 +1,5 @@
1 1 name: shakespeare-js
2   -version: 1.0.0.5
  2 +version: 1.0.0.6
3 3 license: MIT
4 4 license-file: LICENSE
5 5 author: Michael Snoyman <michael@snoyman.com>
@@ -29,7 +29,7 @@ homepage: http://www.yesodweb.com/book/shakespearean-templates
29 29
30 30 library
31 31 build-depends: base >= 4 && < 5
32   - , shakespeare >= 1.0.0.3 && < 1.1
  32 + , shakespeare >= 1.0.1.4 && < 1.1
33 33 , template-haskell
34 34 , text >= 0.7 && < 0.12
35 35
23 shakespeare/Text/Shakespeare.hs
@@ -25,6 +25,7 @@ module Text.Shakespeare
25 25
26 26 import Text.ParserCombinators.Parsec hiding (Line)
27 27 import Language.Haskell.TH.Quote (QuasiQuoter (..))
  28 +import Language.Haskell.TH (appE)
28 29 import Language.Haskell.TH.Syntax
29 30 #if !MIN_VERSION_template_haskell(2,8,0)
30 31 import Language.Haskell.TH.Syntax.Internals
@@ -86,6 +87,10 @@ data ShakespeareSettings = ShakespeareSettings
86 87 , unwrap :: Exp
87 88 , justVarInterpolation :: Bool
88 89 , preConversion :: Maybe PreConvert
  90 + , modifyFinalValue :: Maybe Exp
  91 + -- ^ A transformation applied to the final expression. Most often, this
  92 + -- would be used to force the type of the expression to help make more
  93 + -- meaningful error messages.
89 94 }
90 95
91 96 defaultShakespeareSettings :: ShakespeareSettings
@@ -95,6 +100,7 @@ defaultShakespeareSettings = ShakespeareSettings {
95 100 , intChar = '^'
96 101 , justVarInterpolation = False
97 102 , preConversion = Nothing
  103 + , modifyFinalValue = Nothing
98 104 }
99 105
100 106 instance Lift PreConvert where
@@ -107,14 +113,16 @@ instance Lift PreConversion where
107 113 lift Id = [|Id|]
108 114
109 115 instance Lift ShakespeareSettings where
110   - lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8) =
  116 + lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =
111 117 [|ShakespeareSettings
112 118 $(lift x1) $(lift x2) $(lift x3)
113   - $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8)|]
  119 + $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]
114 120 where
115 121 liftExp (VarE n) = [|VarE $(liftName n)|]
116 122 liftExp (ConE n) = [|ConE $(liftName n)|]
117 123 liftExp _ = error "liftExp only supports VarE and ConE"
  124 + liftMExp Nothing = [|Nothing|]
  125 + liftMExp (Just e) = [|Just|] `appE` liftExp e
118 126 liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]
119 127 liftFlavour NameS = [|NameS|]
120 128 liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]
@@ -222,14 +230,17 @@ contentsToShakespeare rs a = do
222 230 r <- newName "_render"
223 231 c <- mapM (contentToBuilder r) a
224 232 compiledTemplate <- case c of
225   - [] -> [|mempty|]
  233 + -- Make sure we convert this mempty using toBuilder to pin down the
  234 + -- type appropriately
  235 + [] -> fmap (AppE $ wrap rs) [|mempty|]
226 236 [x] -> return x
227 237 _ -> do
228 238 mc <- [|mconcat|]
229 239 return $ mc `AppE` ListE c
230   - if justVarInterpolation rs
231   - then return compiledTemplate
232   - else return $ LamE [VarP r] compiledTemplate
  240 + fmap (maybe id AppE $ modifyFinalValue rs) $
  241 + if justVarInterpolation rs
  242 + then return compiledTemplate
  243 + else return $ LamE [VarP r] compiledTemplate
233 244 where
234 245 contentToBuilder :: Name -> Content -> Q Exp
235 246 contentToBuilder _ (ContentRaw s') = do
2  shakespeare/shakespeare.cabal
... ... @@ -1,5 +1,5 @@
1 1 name: shakespeare
2   -version: 1.0.1.3
  2 +version: 1.0.1.4
3 3 license: MIT
4 4 license-file: LICENSE
5 5 author: Michael Snoyman <michael@snoyman.com>

0 comments on commit 69d3a57

Please sign in to comment.
Something went wrong with that request. Please try again.