Merge pull request #12 from himura/fixture-th

Loading the all fixtures as variables by using TH

tests/Fixtures.hs

@@ -1,47 +1,43 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
 
 module Fixtures where
 
+import Language.Haskell.TH
 import Data.Aeson
 import Data.Attoparsec.ByteString
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
+import qualified Data.ByteString as S
 import Data.Maybe
-import Text.Shakespeare.Text
+import System.Directory
 import System.Environment
 import System.FilePath
 import System.IO.Unsafe (unsafePerformIO)
 import Control.Applicative
 
-fj :: T.Text -> Value
-fj = fromJust . maybeResult . parse json . T.encodeUtf8
+parseJSONValue :: S.ByteString -> Value
+parseJSONValue = fromJust . maybeResult . parse json
 
 fixturePath :: String
 fixturePath = unsafePerformIO $ do
     fromMaybe defaultPath <$> lookupEnv "TWITTER_FIXTURE_PATH"
   where
     defaultPath = takeDirectory __FILE__ </> "fixtures"
 
-loadFixture :: String -> IO Value
-loadFixture filename = fj <$> T.readFile (fixturePath </> filename)
+loadFixture :: (S.ByteString -> a) -> String -> IO a
+loadFixture conv filename = conv <$> S.readFile (fixturePath </> filename)
 
-fixture :: String -> Value
-fixture = unsafePerformIO . loadFixture
+fixture :: (S.ByteString -> a) -> String -> a
+fixture conv = unsafePerformIO . loadFixture conv
 
-errorMsgJson :: Value
-errorMsgJson = fj [st|{"request":"\/1\/statuses\/user_timeline.json","error":"Not authorized"}|]
-
-statusJson :: Value
-statusJson = fixture "status_object.json"
-
-statusEntityJson :: Value
-statusEntityJson = fixture "status_object_with_entity.json"
-
-mediaEntityJson :: Value
-mediaEntityJson = fixture "media_entity.json"
-
-mediaExtendedEntityJson :: Value
-mediaExtendedEntityJson = fixture "media_extended_entity.json"
+loadFixturesTH :: Name -> Q [Dec]
+loadFixturesTH convFn = do
+    files <- runIO $ filter (\fn -> takeExtension fn == ".json") <$> getDirectoryContents fixturePath
+    concat <$> mapM genEachDefs files
+  where
+    genEachDefs filename = do
+        let funN = mkName $ "fixture_" ++ dropExtension filename
+        sigdef <- sigD funN (conT ''Value)
+        bind <- valD (varP funN) (normalB [|fixture $(varE convFn) $(litE (stringL filename))|]) []
+        return [ sigdef, bind ]

tests/TypesTest.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main where
@@ -8,14 +8,14 @@ import Web.Twitter.Types
 import Test.Framework.TH.Prime
 import Test.Framework.Providers.HUnit
 import Test.HUnit
-import Text.Shakespeare.Text
 
 import Data.Aeson hiding (Error)
 import Data.Aeson.Types (parseEither)
 import qualified Data.HashMap.Strict as M
 import Data.Maybe
 
 import Fixtures
+loadFixturesTH 'parseJSONValue
 
 main :: IO ()
 main = $(defaultMainGenerator)
@@ -29,14 +29,14 @@ withJSON js f = either assertFailure id $ do
   return $ f o
 
 case_parseStatus :: Assertion
-case_parseStatus = withJSON statusJson $ \obj -> do
+case_parseStatus = withJSON fixture_status01 $ \obj -> do
   statusId obj @?= 112652479837110273
   statusRetweetCount obj @?= Just 0
   (userScreenName . statusUser) obj @?= "imeoin"
   statusEntities obj @?= Nothing
 
 case_parseStatusIncludeEntities :: Assertion
-case_parseStatusIncludeEntities = withJSON statusEntityJson $ \obj -> do
+case_parseStatusIncludeEntities = withJSON fixture_status_with_entity $ \obj -> do
   statusId obj @?= 112652479837110273
   statusRetweetCount obj @?= Just 0
   (userScreenName . statusUser) obj @?= "imeoin"
@@ -46,15 +46,15 @@ case_parseStatusIncludeEntities = withJSON statusEntityJson $ \obj -> do
 
 case_parseErrorMsg :: Assertion
 case_parseErrorMsg =
-  case parseStatus errorMsgJson of
+  case parseStatus fixture_error_not_authorized of
     Left str -> "Not authorized" @=? str
     Right _ -> assertFailure "errorMsgJson should be parsed as an error."
   where
     parseStatus :: Value -> Either String Status
     parseStatus = parseEither parseJSON
 
 case_parseMediaEntity :: Assertion
-case_parseMediaEntity = withJSON mediaEntityJson $ \obj -> do
+case_parseMediaEntity = withJSON fixture_media_entity $ \obj -> do
   let entities = statusEntities obj
   assert $ isJust entities
   let Just ent = entities
@@ -68,14 +68,14 @@ case_parseMediaEntity = withJSON mediaEntityJson $ \obj -> do
   assert $ M.member "large" sizes
 
 case_parseEmptyEntity :: Assertion
-case_parseEmptyEntity = withJSON (fj [st|{}|]) $ \entity -> do
+case_parseEmptyEntity = withJSON (parseJSONValue "{}") $ \entity -> do
     length (enHashTags entity) @?= 0
     length (enUserMentions entity) @?= 0
     length (enURLs entity) @?= 0
     length (enMedia entity) @?= 0
 
 case_parseEntityHashTag :: Assertion
-case_parseEntityHashTag = withJSON (fj [st|{"symbols":[],"urls":[{"indices":[32,52], "url":"http://t.co/IOwBrTZR", "display_url":"youtube.com/watch?v=oHg5SJ\u2026", "expanded_url":"http://www.youtube.com/watch?v=oHg5SJYRHA0"}],"user_mentions":[{"name":"Twitter API", "indices":[4,15], "screen_name":"twitterapi", "id":6253282, "id_str":"6253282"}],"hashtags":[{"indices":[32,36],"text":"lol"}]}|]) $ \entity -> do
+case_parseEntityHashTag = withJSON fixture_entity01 $ \entity -> do
     length (enHashTags entity) @?= 1
     length (enUserMentions entity) @?= 1
     length (enURLs entity) @?= 1
@@ -95,7 +95,7 @@ case_parseEntityHashTag = withJSON (fj [st|{"symbols":[],"urls":[{"indices":[32,
     hashtag @?= "lol"
 
 case_parseExtendedEntities :: Assertion
-case_parseExtendedEntities = withJSON mediaExtendedEntityJson $ \obj -> do
+case_parseExtendedEntities = withJSON fixture_media_extended_entity $ \obj -> do
     let entities = statusExtendedEntities obj
     assert $ isJust entities
     let Just ent = entities

tests/fixtures/entity01.json

@@ -0,0 +1 @@
+{"symbols":[],"urls":[{"indices":[32,52], "url":"http://t.co/IOwBrTZR", "display_url":"youtube.com/watch?v=oHg5SJ\u2026", "expanded_url":"http://www.youtube.com/watch?v=oHg5SJYRHA0"}],"user_mentions":[{"name":"Twitter API", "indices":[4,15], "screen_name":"twitterapi", "id":6253282, "id_str":"6253282"}],"hashtags":[{"indices":[32,36],"text":"lol"}]}

tests/fixtures/error_not_authorized.json

@@ -0,0 +1 @@
+{"request":"\/1\/statuses\/user_timeline.json","error":"Not authorized"}

twitter-types.cabal

@@ -45,13 +45,14 @@ test-suite tests
     , test-framework-th-prime
     , test-framework-hunit
     , HUnit
-    , shakespeare >= 2.0
     , http-types
     , aeson
     , attoparsec
+    , bytestring
     , text
     , unordered-containers
     , filepath
+    , directory
   other-modules:
     Fixtures