diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs deleted file mode 100644 --- a/Text/Shakespeare/Text.hs +++ /dev/null @@ -1,150 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-missing-fields #-} -module Text.Shakespeare.Text - ( TextUrl - , ToText (..) - , renderTextUrl - , stext - , text - , textFile - , textFileDebug - , textFileReload - , st -- | strict text - , lt -- | lazy text, same as stext :) - -- * 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 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 = toText . show -instance ToText Int64 where toText = toText . show -instance ToText Int where toText = toText . show - -settings :: Q ShakespeareSettings -settings = do - toTExp <- [|toText|] - wrapExp <- [|id|] - unWrapExp <- [|id|] - return $ defaultShakespeareSettings { toBuilder = toTExp - , wrap = wrapExp - , unwrap = unWrapExp - } - - -stext, lt, st, text :: QuasiQuoter -stext = - QuasiQuoter { quoteExp = \s -> do - rs <- settings - render <- [|toLazyText|] - rendered <- shakespeareFromString rs { justVarInterpolation = True } s - return (render `AppE` rendered) - } -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 - } - - -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 - --- | 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) diff --git a/shakespeare-text.cabal b/shakespeare-text.cabal --- a/shakespeare-text.cabal +++ b/shakespeare-text.cabal @@ -1,10 +1,10 @@ name: shakespeare-text -version: 1.0.2 +version: 1.1.0 license: MIT license-file: LICENSE author: Greg Weber maintainer: Greg Weber -synopsis: Interpolation with quasi-quotation: put variables strings +synopsis: Interpolation with quasi-quotation: put variables strings (deprecated) description: interpolation with quasi-quotation: stick haskell variables into haskell strings . @@ -24,45 +24,10 @@ cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/book/shakespearean-templates -extra-source-files: - test/texts/external1.text - test/texts/external2.text - test/ShakespeareTextTest.hs - test.hs library build-depends: base >= 4 && < 5 - , shakespeare >= 1.0 && < 1.3 - , template-haskell - , text >= 0.7 - - exposed-modules: Text.Shakespeare.Text - ghc-options: -Wall - if impl(ghc >= 7.4) - cpp-options: -DGHC_7_4 - - if os(windows) - CPP-Options: "-DWINDOWS" - -test-suite test - hs-source-dirs: test - main-is: ../test.hs - type: exitcode-stdio-1.0 - - ghc-options: -Wall - build-depends: - shakespeare-text - , base >= 4 && < 5 - , HUnit - , hspec >= 1.3 - , text >= 0.7 - - if impl(ghc >= 7.4) - cpp-options: -DGHC_7_4 - - if os(windows) - CPP-Options: "-DWINDOWS" - + , shakespeare >= 2.0 source-repository head type: git diff --git a/test.hs b/test.hs deleted file mode 100644 --- a/test.hs +++ /dev/null @@ -1,5 +0,0 @@ -import ShakespeareTextTest (spec) -import Test.Hspec - -main :: IO () -main = hspec spec diff --git a/test/ShakespeareTextTest.hs b/test/ShakespeareTextTest.hs deleted file mode 100644 --- a/test/ShakespeareTextTest.hs +++ /dev/null @@ -1,155 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -module ShakespeareTextTest (spec) where - -import Test.HUnit hiding (Test) -import Test.Hspec - -import Prelude hiding (reverse) -import Text.Shakespeare.Text -import Data.List (intercalate) -import qualified Data.Text.Lazy as TL -import qualified Data.List -import qualified Data.List as L -import Data.Text (Text, pack, unpack) -import Data.Monoid (mappend) - -spec :: Spec -spec = do - describe "shakespeare-text" $ do - it "text" $ do - let var = "var" - let urlp = (Home, [(pack "p", pack "q")]) - flip telper [text|שלום -#{var} -@{Home} -@?{urlp} -^{jmixin} -|] $ intercalate "\n" - [ "שלום" - , var - , "url" - , "url?p=q" - , "var x;" - ] ++ "\n" - - - it "textFile" $ do - let var = "var" - let urlp = (Home, [(pack "p", pack "q")]) - flip telper $(textFile "test/texts/external1.text") $ unlines - [ "שלום" - , var - , "url" - , "url?p=q" - , "var x;" - ] - - - it "textFileReload" $ do - let var = "var" - let urlp = (Home, [(pack "p", pack "q")]) - flip telper $(textFileReload "test/texts/external1.text") $ unlines - [ "שלום" - , var - , "url" - , "url?p=q" - , "var x;" - ] - -{- TODO - it "textFileReload" $ do - let var = "somevar" - test result = telper result $(textFileReload "test/texts/external2.text") - writeFile "test/texts/external2.text" "var #{var} = 1;" - test "var somevar = 1;" - writeFile "test/texts/external2.text" "var #{var} = 2;" - test "var somevar = 2;" - writeFile "test/texts/external2.text" "var #{var} = 1;" - -} - - - it "text module names" $ - let foo = "foo" - double = 3.14 :: Double - int = -5 :: Int in - telper "oof oof 3.14 -5" - [text|#{Data.List.reverse foo} #{L.reverse foo} #{show double} #{show int}|] - - it "stext module names" $ - let foo = "foo" - double = 3.14 :: Double - int = -5 :: Int in - simpT "oof oof 3.14 -5" - [stext|#{Data.List.reverse foo} #{L.reverse foo} #{show double} #{show int}|] - - it "single dollar at and caret" $ do - telper "$@^" [text|$@^|] - telper "#{@{^{" [text|#\{@\{^\{|] - - it "single dollar at and caret" $ do - simpT "$@^" [stext|$@^|] - simpT "#{@{^{" [stext|#\{@\{^\{|] - - it "dollar operator" $ do - let val = (1 :: Int, (2 :: Int, 3 :: Int)) - telper "2" [text|#{ show $ fst $ snd val }|] - telper "2" [text|#{ show $ fst $ snd $ val}|] - - it "dollar operator" $ do - let val = (1 :: Int, (2 :: Int, 3 :: Int)) - simpT "2" [stext|#{ show $ fst $ snd val }|] - simpT "2" [stext|#{ show $ fst $ snd $ val}|] - -simpT :: String -> TL.Text -> Assertion -simpT a b = pack a @=? TL.toStrict b - - -data Url = Home | Sub SubUrl -data SubUrl = SubUrl -render :: Url -> [(Text, Text)] -> Text -render Home qs = pack "url" `mappend` showParams qs -render (Sub SubUrl) qs = pack "suburl" `mappend` showParams qs - -showParams :: [(Text, Text)] -> Text -showParams [] = pack "" -showParams z = - pack $ '?' : intercalate "&" (map go z) - where - go (x, y) = go' x ++ '=' : go' y - go' = concatMap encodeUrlChar . unpack - --- | Taken straight from web-encodings; reimplemented here to avoid extra --- dependencies. -encodeUrlChar :: Char -> String -encodeUrlChar c - -- List of unreserved characters per RFC 3986 - -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding - | 'A' <= c && c <= 'Z' = [c] - | 'a' <= c && c <= 'z' = [c] - | '0' <= c && c <= '9' = [c] -encodeUrlChar c@'-' = [c] -encodeUrlChar c@'_' = [c] -encodeUrlChar c@'.' = [c] -encodeUrlChar c@'~' = [c] -encodeUrlChar ' ' = "+" -encodeUrlChar y = - let (a, c) = fromEnum y `divMod` 16 - b = a `mod` 16 - showHex' x - | x < 10 = toEnum $ x + (fromEnum '0') - | x < 16 = toEnum $ x - 10 + (fromEnum 'A') - | otherwise = error $ "Invalid argument to showHex: " ++ show x - in ['%', showHex' b, showHex' c] - - - - -jmixin :: TextUrl url -jmixin = [text|var x;|] - -telper :: String -> TextUrl Url -> Assertion -telper res h = pack res @=? TL.toStrict (renderTextUrl render h) - -instance Show Url where - show _ = "FIXME remove this instance show Url" diff --git a/test/texts/external1.text b/test/texts/external1.text deleted file mode 100644 --- a/test/texts/external1.text +++ /dev/null @@ -1,5 +0,0 @@ -שלום -#{var} -@{Home} -@?{urlp} -^{jmixin} diff --git a/test/texts/external2.text b/test/texts/external2.text deleted file mode 100644 --- a/test/texts/external2.text +++ /dev/null @@ -1,1 +0,0 @@ -var #{var} = 2;