diff --git a/hurriyet.cabal b/hurriyet.cabal --- a/hurriyet.cabal +++ b/hurriyet.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: hurriyet -version: 0.1.0.0 +version: 0.2.0.0 license: BSD3 license-file: LICENSE author: Yiğit Özkavcı @@ -18,12 +18,13 @@ To get started, see @Hurriyet@ module below. library - build-depends: base >= 4.5 && <= 4.9, + build-depends: base >= 4.5 && <= 4.9.1.0, aeson, bytestring, http-client, http-client-tls, - text + text, + mtl exposed-modules: Hurriyet, Hurriyet.Services, Hurriyet.Services.Article, @@ -43,7 +44,12 @@ main-is: Spec.hs build-depends: base, hurriyet, - hspec >= 1.8 + bytestring, + text, + aeson, + hspec >= 1.8, + here >= 1.2.11, + containers hs-source-dirs: tests default-language: Haskell2010 diff --git a/lib/Hurriyet.hs b/lib/Hurriyet.hs --- a/lib/Hurriyet.hs +++ b/lib/Hurriyet.hs @@ -20,6 +20,7 @@ import Data.ByteString.Char8 as C import Hurriyet.Services import Data.Aeson (decode, eitherDecode) +import Control.Monad.Reader {- Planned client usage: @@ -101,86 +102,91 @@ response <- httpLbs request manager return $ responseBody response +type ServiceResponse a = Reader Client (IO (Either String a)) + {-| Get a single page -} -getPage :: Client -> Id -> IO (Either String Page) -getPage client id = - fetchResource client (Show PageResource id) >>= \str -> - return $ eitherDecode str +getPage :: Id -> ServiceResponse Page +getPage id = do + client <- ask + return $ eitherDecode <$> fetchResource client (Show PageResource id) {-| Get all pages -} -getPages :: Client -> IO (Either String [Page]) -getPages client = - fetchResource client (List PageResource) >>= \str -> - return $ eitherDecode str +getPages :: ServiceResponse [Page] +getPages = do + client <- ask + return $ eitherDecode <$> fetchResource client (List PageResource) {-| Get a single news photo gallery -} -getNewsPhotoGallery :: Client -> Id -> IO (Either String NewsPhotoGallery) -getNewsPhotoGallery client id = - fetchResource client (Show NewsPhotoGalleryResource id) >>= \str -> - return $ eitherDecode str +getNewsPhotoGallery :: Id -> ServiceResponse NewsPhotoGallery +getNewsPhotoGallery id = do + client <- ask + return $ eitherDecode <$> fetchResource client (Show NewsPhotoGalleryResource id) {-| Get all news photo galleries -} -getNewsPhotoGalleries :: Client -> IO (Either String [NewsPhotoGallery]) -getNewsPhotoGalleries client = - fetchResource client (List NewsPhotoGalleryResource) >>= \str -> - return $ eitherDecode str +getNewsPhotoGalleries :: ServiceResponse [NewsPhotoGallery] +getNewsPhotoGalleries = do + client <- ask + return $ eitherDecode <$> fetchResource client (List NewsPhotoGalleryResource) {-| Get a single column -} -getColumn :: Client -> Id -> IO (Either String Column) -getColumn client id = - fetchResource client (Show ColumnResource id) >>= \str -> - return $ eitherDecode str +getColumn :: Id -> ServiceResponse Column +getColumn id = do + client <- ask + return $ eitherDecode <$> fetchResource client (Show ColumnResource id) {-| Get all columns -} -getColumns :: Client -> IO (Either String [Column]) -getColumns client = - fetchResource client (List ColumnResource) >>= \str -> - return $ eitherDecode str +getColumns :: ServiceResponse [Column] +getColumns = do + client <- ask + return $ eitherDecode <$> fetchResource client (List ColumnResource) {-| Get a single path -} -getPath :: Client -> Id -> IO (Either String Path) -getPath client id = - fetchResource client (Show PathResource id) >>= \str -> - return $ eitherDecode str +getPath :: Id -> ServiceResponse Path +getPath id = do + client <- ask + return $ eitherDecode <$> fetchResource client (Show PathResource id) {-| Get all paths -} -getPaths :: Client -> IO (Either String [Path]) -getPaths client = - fetchResource client (List PathResource) >>= \str -> - return $ eitherDecode str +getPaths :: ServiceResponse [Path] +getPaths = do + client <- ask + return $ eitherDecode <$> fetchResource client (List PathResource) {-| Get a single writer -} -getWriter :: Client -> Id -> IO (Either String Writer) -getWriter client id = - fetchResource client (Show WriterResource id) >>= \str -> - return $ eitherDecode str +getWriter :: Id -> ServiceResponse Writer +getWriter id = do + client <- ask + return $ eitherDecode <$> fetchResource client (Show WriterResource id) {-| Get all writers -} -getWriters :: Client -> IO (Either String [Writer]) -getWriters client = - fetchResource client (List WriterResource) >>= \str -> - return $ eitherDecode str +getWriters :: ServiceResponse [Writer] +getWriters = do + client <- ask + return $ eitherDecode <$> fetchResource client (List WriterResource) {-| Get single article -} -getArticle :: Client -> Id -> IO (Either String Article) -getArticle client id = - fetchResource client (Show ArticleResource id) >>= \str -> - return $ eitherDecode str +getArticle :: Id -> ServiceResponse Article +getArticle id = do + client <- ask + return $ eitherDecode <$> fetchResource client (Show ArticleResource id) {-| Get all articles -} -getArticles :: Client -> IO (Either String [Article]) -getArticles client = - fetchResource client (List ArticleResource) >>= \str -> - return $ eitherDecode str +getArticles :: ServiceResponse [Article] +getArticles = do + client <- ask + return $ eitherDecode <$> fetchResource client (List ArticleResource) + +withClient :: Client -> Reader Client a -> a +withClient client reader = runReader reader client diff --git a/lib/Hurriyet/Services/Article.hs b/lib/Hurriyet/Services/Article.hs --- a/lib/Hurriyet/Services/Article.hs +++ b/lib/Hurriyet/Services/Article.hs @@ -7,7 +7,7 @@ import Hurriyet.Services.File data Article = Article - { _id :: String + { id' :: String , contentType :: String , createdDate :: String , description :: String @@ -20,11 +20,11 @@ , startDate :: String , title :: String , url :: String - } deriving (Generic, Show) + } deriving (Generic, Show, Eq) instance FromJSON Article where parseJSON = withObject "article" $ \o -> do - _id <- o .: "Id" + id' <- o .: "Id" contentType <- o .: "ContentType" createdDate <- o .: "CreatedDate" description <- o .: "Description" diff --git a/lib/Hurriyet/Services/Column.hs b/lib/Hurriyet/Services/Column.hs --- a/lib/Hurriyet/Services/Column.hs +++ b/lib/Hurriyet/Services/Column.hs @@ -17,8 +17,8 @@ , startDate :: String , title :: String , url :: String - , writerId :: String - } deriving (Generic, Show) + , writerId :: Maybe String + } deriving (Generic, Show, Eq) instance FromJSON Column where parseJSON = withObject "column" $ \o -> do @@ -32,7 +32,7 @@ startDate <- o .: "StartDate" title <- o .: "Title" url <- o .: "Url" - writerId <- o .: "WriterId" + writerId <- o .:? "WriterId" return Column {..} instance ToJSON Column diff --git a/lib/Hurriyet/Services/File.hs b/lib/Hurriyet/Services/File.hs --- a/lib/Hurriyet/Services/File.hs +++ b/lib/Hurriyet/Services/File.hs @@ -8,7 +8,7 @@ data File = File { fileUrl :: String , metadata :: Metadata - } deriving(Generic, Show) + } deriving(Generic, Show, Eq) instance FromJSON File where parseJSON = withObject "file" $ \o -> do @@ -21,7 +21,7 @@ newtype Metadata = Metadata { title :: String -- , description :: String -- This field does not exist on article show page. Tracking issue: https://github.com/hurriyet/developers.hurriyet.com.tr/issues/28 - } deriving(Generic, Show) + } deriving(Generic, Show, Eq) instance FromJSON Metadata where parseJSON = withObject "metadata" $ \o -> do diff --git a/lib/Hurriyet/Services/NewsPhotoGallery.hs b/lib/Hurriyet/Services/NewsPhotoGallery.hs --- a/lib/Hurriyet/Services/NewsPhotoGallery.hs +++ b/lib/Hurriyet/Services/NewsPhotoGallery.hs @@ -12,12 +12,12 @@ , createdDate :: String , description :: String , files :: [File] - , modifiedDate :: String + , modifiedDate :: Maybe String , path :: String , startDate :: String , title :: String , url :: String - } deriving (Generic, Show) + } deriving (Generic, Show, Eq) instance FromJSON NewsPhotoGallery where parseJSON = withObject "news_photo_gallery" $ \o -> do @@ -26,7 +26,7 @@ createdDate <- o .: "CreatedDate" description <- o .: "Description" files <- o .: "Files" - modifiedDate <- o .: "ModifiedDate" + modifiedDate <- o .:? "ModifiedDate" path <- o .: "Path" startDate <- o .: "StartDate" title <- o .: "Title" diff --git a/lib/Hurriyet/Services/Page.hs b/lib/Hurriyet/Services/Page.hs --- a/lib/Hurriyet/Services/Page.hs +++ b/lib/Hurriyet/Services/Page.hs @@ -14,7 +14,7 @@ Currently pages endpoint does not respond. -} , url :: String - } deriving (Generic, Show) + } deriving (Generic, Show, Eq) instance FromJSON Page where parseJSON = withObject "page" $ \o -> do diff --git a/lib/Hurriyet/Services/Path.hs b/lib/Hurriyet/Services/Path.hs --- a/lib/Hurriyet/Services/Path.hs +++ b/lib/Hurriyet/Services/Path.hs @@ -9,7 +9,7 @@ { _id :: String , path :: String , title :: String - } deriving (Generic, Show) + } deriving (Generic, Show, Eq) instance FromJSON Path where parseJSON = withObject "path" $ \o -> do diff --git a/lib/Hurriyet/Services/Writer.hs b/lib/Hurriyet/Services/Writer.hs --- a/lib/Hurriyet/Services/Writer.hs +++ b/lib/Hurriyet/Services/Writer.hs @@ -14,7 +14,7 @@ , files :: [File] , path :: String , url :: String - } deriving (Generic, Show) + } deriving (Generic, Show, Eq) instance FromJSON Writer where parseJSON = withObject "writer" $ \o -> do diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -1,10 +1,128 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Main where - -import Hurriyet -import Test.Hspec - +-------------------------------------------------------------------------------- +import Test.Hspec +import Data.String +import Data.Aeson +import Data.Text.Lazy.Encoding (encodeUtf8) +import Data.Text.Lazy (Text, pack) +import Data.Either (isLeft) +import Data.Monoid ((<>)) +import Control.Monad (when) +import Data.Proxy (Proxy(..)) +import Data.Foldable (forM_) +-------------------------------------------------------------------------------- +import qualified Hurriyet as H +import qualified Hurriyet.Services as HS +-------------------------------------------------------------------------------- + +testApiKey :: IsString s => s +testApiKey = "some_api_key" + +testClient :: H.Client +testClient = H.getClient testApiKey + +{- Beware: anyone using this function should annotate return + - value, since we are doing json decoding. + -} +testDecoding :: forall proxy a. (Show a, FromJSON a) => proxy a -> Text -> IO () +testDecoding _ str = do + let result = eitherDecode (encodeUtf8 str) :: Either String a + when (isLeft result) $ + expectationFailure $ "Could not decode service: " <> fromLeft result + return () + +fromLeft :: Show b => Either a b -> a +fromLeft (Right x) = error $ "Should not have got a right value: " ++ show x +fromLeft (Left x) = x + +data Operation = List H.Resource + | Show H.Resource + +stubbedResponseFilename :: Operation -> String +stubbedResponseFilename (List resource) = show resource <> "_list_response" +stubbedResponseFilename (Show resource) = show resource <> "_show_response" + +stubbedResponse :: Operation -> IO Text +stubbedResponse op = + let + filepath = "tests/static/" <> stubbedResponseFilename op <> ".json" + in + pack <$> readFile filepath + +serviceTestMapping :: + [ + ( String -- Name of the resource test. Will be used as description + , ( (H.Operation, String) -- Endpoint check for list operation + , (H.Operation, String) -- Endpoint check for show operation + , (Operation, Text -> IO ()) -- List operation and its response decoder + , (Operation, Text -> IO ()) -- Show operation and its response decoder + ) + ) + ] + +serviceTestMapping = + [ ("article", ( (H.List H.ArticleResource, "articles") + , (H.Show H.ArticleResource "3", "articles/3") + , (List H.ArticleResource, testDecoding (Proxy :: Proxy [HS.Article])) + , (Show H.ArticleResource, testDecoding (Proxy :: Proxy HS.Article)) + ) + ) + , ("column", ( (H.List H.ColumnResource, "columns") + , (H.Show H.ColumnResource "3", "columns/3") + , (List H.ColumnResource, testDecoding (Proxy :: Proxy [HS.Column])) + , (Show H.ColumnResource, testDecoding (Proxy :: Proxy HS.Column)) + ) + ) + , ("news_photo_gallery", ( (H.List H.NewsPhotoGalleryResource, "newsphotogalleries") + , (H.Show H.NewsPhotoGalleryResource "3", "newsphotogalleries/3") + , (List H.NewsPhotoGalleryResource, testDecoding (Proxy :: Proxy [HS.NewsPhotoGallery])) + , (Show H.NewsPhotoGalleryResource, testDecoding (Proxy :: Proxy HS.NewsPhotoGallery)) + ) + ) + -- Pages endpoint is inaccessible at the moment of testing + -- , ("page", ( (H.List H.PageResource, "pages") + -- , (H.Show H.PageResource "3", "pages/3") + -- , (List H.PageResource, testDecoding (Proxy :: Proxy [HS.Page])) + -- , (Show H.PageResource, testDecoding (Proxy :: Proxy HS.Page)) + -- ) + -- ) + , ("path", ( (H.List H.PathResource, "paths") + , (H.Show H.PathResource "3", "paths/3") + , (List H.PathResource, testDecoding (Proxy :: Proxy [HS.Path])) + , (Show H.PathResource, testDecoding (Proxy :: Proxy HS.Path)) + ) + ) + , ("writer", ( (H.List H.WriterResource, "writers") + , (H.Show H.WriterResource "3", "writers/3") + , (List H.WriterResource, testDecoding (Proxy :: Proxy [HS.Writer])) + , (Show H.WriterResource, testDecoding (Proxy :: Proxy HS.Writer)) + ) + ) + ] + main :: IO () -main = hspec $ - describe "apiKey returns api key string" $ - it "returns" $ - take 1 (show apiKey) `shouldBe` "\"" +main = hspec $ do + describe "client" $ do + it "saves the api key" $ + H.apiKey testClient `shouldBe` testApiKey + it "reads" $ do + _ <- H.withClient testClient H.getArticles + return () + describe "resources" $ + forM_ serviceTestMapping $ \resource -> + context (fst resource) $ do + let (listUrl, showUrl, (listOperation, listDecodeTester), (showOperation, showDecodeTester)) = snd resource + context "list" $ + it "has the right endpoint" $ + H.getUrl (fst listUrl) `shouldBe` H.baseUrl ++ snd listUrl + it "parses response" $ + listDecodeTester =<< stubbedResponse listOperation + context "show" $ + it "has the right endpoint" $ + H.getUrl (fst showUrl) `shouldBe` H.baseUrl ++ snd showUrl + it "parses response" $ + showDecodeTester =<< stubbedResponse showOperation +