File: Text.hs

package info (click to toggle)
haskell-shakespeare 2.1.1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 532 kB
  • sloc: haskell: 6,485; makefile: 2
file content (213 lines) | stat: -rw-r--r-- 6,519 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
-- | A Shakespearean module for general text processing, introducing type-safe,
-- compile-time variable interpolation.
--
-- Text templates use the same parser as for other shakespearean templates
-- which enables variable interpolation using @#{..}@.  The parser also
-- recognize the @@{..}@ and @^{..}@ syntax.
--
-- If it is necessary that your template produces the output containing one of
-- the interpolation syntax you can escape the sequence using a backslash:
--
-- > λ> :set -XQuasiQuotes
-- > λ> let bar = 23 :: Int in [st|#{bar}|] :: Text
--
-- produces "23", but
--
-- > λ> let bar = 23 :: Int in [st|#\{bar}|] :: Text
--
-- returns "#{bar}".  The escaping backslash is removed from the output.
--
-- Further reading:
-- Shakespearean templates: <https://www.yesodweb.com/book/shakespearean-templates>
module Text.Shakespeare.Text
    ( TextUrl
    , ToText (..)
    , renderTextUrl
    , stext
    , stextFile
    , text
    , textFile
    , textFileDebug
    , textFileReload
    , st -- | strict text
    , lt -- | lazy text, same as stext :)
    , sbt -- | strict text whose left edge is aligned with bar ('|')
    , lbt -- | lazy text, whose left edge is aligned with bar ('|')
    -- * Yesod code generation
    , codegen
    , codegenSt
    , codegenFile
    , codegenFileReload
    ) where

import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax
import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText)
import Data.Text.Lazy.Builder.Int (decimal)
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Text.Shakespeare
import Data.Int (Int32, Int64)

renderTextUrl :: RenderUrl url -> TextUrl url -> TL.Text
renderTextUrl r s = toLazyText $ s r

type TextUrl url = RenderUrl url -> Builder

class ToText a where
    toText :: a -> Builder
instance ToText Builder where toText = id
instance ToText [Char ] where toText = fromLazyText . TL.pack
instance ToText TS.Text where toText = fromText
instance ToText TL.Text where toText = fromLazyText

instance ToText Int32 where toText = decimal
instance ToText Int64 where toText = decimal
instance ToText Int   where toText = decimal

settings :: Q ShakespeareSettings
settings = do
  toTExp <- [|toText|]
  wrapExp <- [|id|]
  unWrapExp <- [|id|]
  return $ defaultShakespeareSettings { toBuilder = toTExp
  , wrap = wrapExp
  , unwrap = unWrapExp
  }

-- | "Simple text" quasi-quoter. May only be used to generate expressions.
--
-- Generated expressions have type 'TL.Text'.
--
-- @
-- >>> do let x = "world"
--        'Data.Text.Lazy.IO.putStrLn' ['stext'|Hello, #{x}!|]
-- Hello, world!
-- @
stext :: QuasiQuoter
stext =
  QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    render <- [|toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

lt, st, text, lbt, sbt :: QuasiQuoter
lt = stext

st = 
  QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    render <- [|TL.toStrict . toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

text = QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    quoteExp (shakespeare rs) $ filter (/='\r') s
    }

dropBar :: [TL.Text] -> [TL.Text]
dropBar [] = []
dropBar (c:cx) = c:dropBar' cx
  where
    dropBar' txt = reverse $ drop 1 $ map (TL.drop 1 . TL.dropWhile (/= '|')) $ reverse txt

lbt = 
  QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    render <- [|TL.unlines . dropBar . TL.lines . toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

sbt = 
  QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    render <- [|TL.toStrict . TL.unlines . dropBar . TL.lines . toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

textFile :: FilePath -> Q Exp
textFile fp = do
    rs <- settings
    shakespeareFile rs fp


textFileDebug :: FilePath -> Q Exp
textFileDebug = textFileReload
{-# DEPRECATED textFileDebug "Please use textFileReload instead" #-}

textFileReload :: FilePath -> Q Exp
textFileReload fp = do
    rs <- settings
    shakespeareFileReload rs fp

-- | Like 'stext', but reads an external file at compile-time.
--
-- @since 2.0.22
stextFile :: FilePath -> Q Exp
stextFile fp = do
  rs <- settings
  [|toLazyText $(shakespeareFile rs { justVarInterpolation = True } fp)|]

-- | codegen is designed for generating Yesod code, including templates
-- So it uses different interpolation characters that won't clash with templates.
codegenSettings :: Q ShakespeareSettings
codegenSettings = do
  toTExp <- [|toText|]
  wrapExp <- [|id|]
  unWrapExp <- [|id|]
  return $ defaultShakespeareSettings { toBuilder = toTExp
  , wrap = wrapExp
  , unwrap = unWrapExp
  , varChar = '~'
  , urlChar = '*'
  , intChar = '&'
  , justVarInterpolation = True -- always!
  }

-- | codegen is designed for generating Yesod code, including templates
-- So it uses different interpolation characters that won't clash with templates.
-- You can use the normal text quasiquoters to generate code
codegen :: QuasiQuoter
codegen =
  QuasiQuoter { quoteExp = \s -> do
    rs <- codegenSettings
    render <- [|toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

-- | Generates strict Text
-- codegen is designed for generating Yesod code, including templates
-- So it uses different interpolation characters that won't clash with templates.
codegenSt :: QuasiQuoter
codegenSt =
  QuasiQuoter { quoteExp = \s -> do
    rs <- codegenSettings
    render <- [|TL.toStrict . toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

codegenFileReload :: FilePath -> Q Exp
codegenFileReload fp = do
    rs <- codegenSettings
    render <- [|TL.toStrict . toLazyText|]
    rendered <- shakespeareFileReload rs{ justVarInterpolation = True } fp
    return (render `AppE` rendered)

codegenFile :: FilePath -> Q Exp
codegenFile fp = do
    rs <- codegenSettings
    render <- [|TL.toStrict . toLazyText|]
    rendered <- shakespeareFile rs{ justVarInterpolation = True } fp
    return (render `AppE` rendered)