diff --git a/shakespeare-text.cabal b/shakespeare-text.cabal --- a/shakespeare-text.cabal +++ b/shakespeare-text.cabal @@ -1,5 +1,5 @@ name: shakespeare-text -version: 0.10.2 +version: 0.10.3 license: BSD3 license-file: LICENSE author: Greg Weber @@ -25,13 +25,14 @@ build-type: Simple homepage: http://www.yesodweb.com/book/templates extra-source-files: - test/external1.text - test/external2.text - test/main.hs + test/texts/external1.text + test/texts/external2.text + test/ShakespeareTextTest.hs + test.hs library build-depends: base >= 4 && < 5 - , shakespeare >= 0.10 + , shakespeare >= 0.10 && < 0.11 , template-haskell , text >= 0.7 && < 0.12 @@ -40,7 +41,7 @@ test-suite test hs-source-dirs: test - main-is: main.hs + main-is: ../test.hs type: exitcode-stdio-1.0 ghc-options: -Wall @@ -48,7 +49,7 @@ shakespeare-text >= 0.10 && < 0.11 , base >= 4 && < 5 , HUnit - , hspec >= 0.8 && < 0.9 + , hspec >= 0.8 && < 0.10 , text >= 0.7 && < 0.12 diff --git a/test.hs b/test.hs new file mode 100644 --- /dev/null +++ b/test.hs @@ -0,0 +1,5 @@ +import ShakespeareTextTest (specs) +import Test.Hspec + +main :: IO () +main = hspecX $ descriptions [specs] diff --git a/test/ShakespeareTextTest.hs b/test/ShakespeareTextTest.hs new file mode 100644 --- /dev/null +++ b/test/ShakespeareTextTest.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +module ShakespeareTextTest (specs) where + +import Test.HUnit hiding (Test) +import Test.Hspec +import Test.Hspec.HUnit () + +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) + +specs :: [Spec] +specs = describe "shakespeare-text" + [ it "text" $ do + let var = "var" + let urlp = (Home, [(pack "p", pack "q")]) + flip telper [text|שלום +#{var} +@{Home} +@?{urlp} +^{jmixin} +|] $ intercalate "\r\n" + [ "שלום" + , var + , "url" + , "url?p=q" + , "var x;" + ] ++ "\r\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 "textFileDebug" $ do + let var = "var" + let urlp = (Home, [(pack "p", pack "q")]) + flip telper $(textFileDebug "test/texts/external1.text") $ unlines + [ "שלום" + , var + , "url" + , "url?p=q" + , "var x;" + ] + +{- TODO + , it "textFileDebugChange" $ do + let var = "somevar" + test result = telper result $(textFileDebug "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/external1.text b/test/external1.text deleted file mode 100644 --- a/test/external1.text +++ /dev/null @@ -1,5 +0,0 @@ -שלום -#{var} -@{Home} -@?{urlp} -^{jmixin} diff --git a/test/external2.text b/test/external2.text deleted file mode 100644 --- a/test/external2.text +++ /dev/null @@ -1,1 +0,0 @@ -var #{var} = 2; diff --git a/test/main.hs b/test/main.hs deleted file mode 100644 --- a/test/main.hs +++ /dev/null @@ -1,157 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -import Test.HUnit hiding (Test) -import Test.Hspec -import Test.Hspec.HUnit () - -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) - -main :: IO () -main = hspecX $ descriptions [specs] - -specs :: [Spec] -specs = describe "shakespeare-text" - [ it "text" $ do - let var = "var" - let urlp = (Home, [(pack "p", pack "q")]) - flip telper [text|שלום -#{var} -@{Home} -@?{urlp} -^{jmixin} -|] $ intercalate "\r\n" - [ "שלום" - , var - , "url" - , "url?p=q" - , "var x;" - ] ++ "\r\n" - - - , it "textFile" $ do - let var = "var" - let urlp = (Home, [(pack "p", pack "q")]) - flip telper $(textFile "test/external1.text") $ unlines - [ "שלום" - , var - , "url" - , "url?p=q" - , "var x;" - ] - - - , it "textFileDebug" $ do - let var = "var" - let urlp = (Home, [(pack "p", pack "q")]) - flip telper $(textFileDebug "test/external1.text") $ unlines - [ "שלום" - , var - , "url" - , "url?p=q" - , "var x;" - ] - -{- TODO - , it "textFileDebugChange" $ do - let var = "somevar" - test result = telper result $(textFileDebug "test/external2.text") - writeFile "test/external2.text" "var #{var} = 1;" - test "var somevar = 1;" - writeFile "test/external2.text" "var #{var} = 2;" - test "var somevar = 2;" - writeFile "test/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 new file mode 100644 --- /dev/null +++ b/test/texts/external1.text @@ -0,0 +1,5 @@ +שלום +#{var} +@{Home} +@?{urlp} +^{jmixin} diff --git a/test/texts/external2.text b/test/texts/external2.text new file mode 100644 --- /dev/null +++ b/test/texts/external2.text @@ -0,0 +1,1 @@ +var #{var} = 2;