kawhi (empty) → 0.0.1
raw patch · 7 files changed
+711/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, exceptions, http-client, http-conduit, http-types, kawhi, mtl, safe, scientific, smallcheck, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck, text
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- kawhi.cabal +61/−0
- library/Control/Monad/Http.hs +74/−0
- library/NBA/Stats.hs +351/−0
- tests/NBA/Stats/Tests.hs +196/−0
- tests/Tests.hs +6/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Aaron Taylor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ kawhi.cabal view
@@ -0,0 +1,61 @@+name: kawhi+version: 0.0.1+synopsis: stats.NBA.com library+description: Functions and types for interacting with stats.NBA.com+homepage: https://github.com/hamsterdam/kawhi+license: MIT+license-file: LICENSE+author: Aaron Taylor+maintainer: aaron@hamsterdam.co+category: API+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: library+ exposed-modules:+ Control.Monad.Http+ NBA.Stats+ other-modules:+ build-depends:+ base >= 4.8 && < 5,+ aeson >= 0.11,+ bytestring >= 0.10,+ exceptions >= 0.8,+ http-conduit >= 2.1,+ http-client >= 0.4,+ http-types >= 0.9,+ mtl >= 2.2,+ safe >= 0.3,+ scientific >= 0.3,+ text >= 1.2+ ghc-options: -Wall+ default-language: Haskell2010++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Tests.hs+ other-modules: NBA.Stats.Tests+ build-depends:+ base,+ kawhi,+ aeson,+ bytestring,+ exceptions,+ http-client,+ http-types,+ mtl,+ scientific,+ smallcheck,+ tasty,+ tasty-hunit,+ tasty-quickcheck,+ tasty-smallcheck,+ text+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/hamsterdam/kawhi
+ library/Control/Monad/Http.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}++{-|+ Copyright: Aaron Taylor, 2016+ License: MIT+ Maintainer: aaron@hamsterdam.co++ Class, instances and transformer for monads capable of HTTP requests.++ In some cases, it is useful to generalize this capability. For example, it can be used provide mock responses for testing.+-}+module Control.Monad.Http (+ -- * Class+ MonadHttp(..),++ -- * Transformer+ HttpT(..),+ runHttpT+) where++import qualified Control.Monad.Catch as Catch+import qualified Control.Monad.Except as Except+import qualified Control.Monad.Reader as Reader+import qualified Control.Monad.Trans as Trans+import qualified Data.ByteString.Lazy as LBS+import qualified Network.HTTP.Simple as HTTPSimple+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types as HTTP++{-|+ The class of monads capable of HTTP requests.+-}+class Monad m => MonadHttp m where+ performRequest :: HTTP.Request -> m (HTTP.Response LBS.ByteString)++instance MonadHttp IO where+ performRequest = HTTPSimple.httpLbs++instance Catch.MonadThrow m => MonadHttp (HttpT m) where+ performRequest _ = check+ where+ check = do+ response <- Reader.ask+ let status = HTTP.responseStatus response+ if status >= HTTP.ok200 && status < HTTP.multipleChoices300+ then return response+ else Catch.throwM $ HTTP.StatusCodeException status [] (HTTP.createCookieJar [])++instance Trans.MonadIO m => MonadHttp (Except.ExceptT e m) where+ performRequest = HTTPSimple.httpLbs++{-|+ An HTTP transformer monad parameterized by an inner monad 'm'.+-}+newtype HttpT m a = HttpT { unHttpT :: Reader.ReaderT (HTTP.Response LBS.ByteString) m a }+ deriving (Functor, Applicative, Monad, Trans.MonadTrans, Catch.MonadThrow, Catch.MonadCatch, Trans.MonadIO, Reader.MonadReader (HTTP.Response LBS.ByteString))++{-|+ Run an HTTP monad action and extract the inner monad.+-}+runHttpT ::+ HttpT m a -- ^ The HTTP monad transformer+ -> HTTP.Response LBS.ByteString -- ^ The response+ -> m a -- ^ The resulting inner monad+runHttpT = Reader.runReaderT . unHttpT++instance Except.MonadError e m => Except.MonadError e (HttpT m) where+ throwError = Trans.lift . Except.throwError+ catchError m f = HttpT . Reader.ReaderT $ \r -> Except.catchError+ (runHttpT m r)+ (\e -> runHttpT (f e) r)
+ library/NBA/Stats.hs view
@@ -0,0 +1,351 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-|+ Module: NBA.Stats+ Copyright: Aaron Taylor, 2016+ License: MIT+ Maintainer: aaron@hamsterdam.co++ Functions and types for interacting with <http://stats.NBA.com NBA Stats>.+-}+module NBA.Stats (+ -- * How to use this library+ -- $use++ -- * Simple API+ getSplitRows,+ getSplitRow,++ -- * Generic API+ getSplitRowsGeneric,+ getSplitRowGeneric,++ -- * Types+ Stats(..),+ Split(..),+ SplitName,+ SplitColumn,+ SplitRow,+ StatsPath,+ StatsParameters,+ StatsError(..),++ -- * Utility+ domain,+ getRequest,+) where++import qualified Control.Monad.Except as Except+import qualified Control.Monad.Trans as Trans+import qualified Control.Monad.Http as MonadHttp+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import Data.Aeson ((.:), (.=))+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString as SBS+import qualified Data.List as List+import Data.Monoid ((<>))+import qualified Data.Text as Text+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Simple as HTTP+import qualified Safe++{- |+ Gets all the rows in a NBA Stats split.++ When using this function in a custom monad transformer, it may be desirable to use the generic version of this function, 'getSplitRowsGeneric', instead.+-}+getSplitRows ::+ (Aeson.FromJSON a)+ => StatsPath -- ^ The URL path for the stats web page containing the split.+ -> SplitName -- ^ The split name.+ -> StatsParameters -- ^ The parameters for customizing the stats.+ -> IO (Either StatsError [a]) -- ^ The return value: an IO action resulting in an error or split rows.+getSplitRows path splitName params = Except.runExceptT $ getSplitRowsGeneric path splitName params++{- |+ Gets a row in a NBA Stats split.++ When using this function in a custom monad transformer, it may be desirable to use the generic version of this function, 'getSplitRowGeneric', instead.+-}+getSplitRow ::+ (Eq v, Show v, Aeson.FromJSON v, Aeson.FromJSON a)+ => StatsPath -- ^ The URL path for the stats web page containing the split.+ -> SplitName -- ^ The split name.+ -> SplitColumn -- ^ The column name key for a the desired row.+ -> v -- ^ The expected row value associated with the column name key for a the desired row.+ -> StatsParameters -- ^ The parameters for customizing the stats.+ -> IO (Either StatsError a) -- ^ The return value: an IO action resulting in an error or a split row.+getSplitRow path splitName key value params = Except.runExceptT $ getSplitRowGeneric path splitName key value params++{- |+ Gets all the rows in a NBA Stats split.++ The simpler version of this function, 'getSplitRows', has a concrete 'm'.+-}+getSplitRowsGeneric ::+ (Trans.MonadIO m, MonadHttp.MonadHttp m, Except.MonadError StatsError m, Aeson.FromJSON a)+ => StatsPath -- ^ The URL path for the stats web page containing the split.+ -> SplitName -- ^ The split name.+ -> StatsParameters -- ^ The parameters for customizing the stats.+ -> m [a] -- ^ The return value: an action resulting in an error or split rows.+getSplitRowsGeneric path splitName params = do+ response <- get path params+ split <- findSplit response splitName+ traverse (parseSplitRow $ columns split) $ rows split++{- |+ Gets a row in an NBA Stats split.++ The simpler version of this function, 'getSplitRows', has a concrete 'm'.+-}+getSplitRowGeneric ::+ (Trans.MonadIO m, MonadHttp.MonadHttp m, Except.MonadError StatsError m, Eq v, Show v, Aeson.FromJSON v, Aeson.FromJSON a)+ => StatsPath -- ^ The URL path for the stats web page containing the split.+ -> SplitName -- ^ The split name.+ -> SplitColumn -- ^ The column name key for a the desired row.+ -> v -- ^ The expected row value associated with the column name key for a the desired row.+ -> StatsParameters -- ^ The parameters for customizing the stats.+ -> m a -- ^ The return value: an action resulting in an error or a split row.+getSplitRowGeneric path splitName key value params = do+ response <- get path params+ split <- findSplit response splitName+ keyIndex <- maybe+ (Except.throwError $ SplitColumnNameNotFound $ Text.unpack key)+ return+ (List.elemIndex key (columns split))+ row <- maybe+ (Except.throwError $ SplitKeyNotFound $ show value)+ return+ (List.find+ (\row -> maybe+ False+ (==value)+ (Safe.atMay row keyIndex >>= Aeson.parseMaybe Aeson.parseJSON))+ (rows split))+ parseSplitRow (columns split) row++{- |+ An NBA Stats split.++ This type represents splits available from NBA Stats.+-}+data Split =+ -- | Constructor for a split.+ Split {+ -- | The split's name.+ name :: SplitName,+ -- | The split's column names.+ columns :: [SplitColumn],+ -- | The split's rows of data.+ rows :: [SplitRow]+ }+ deriving (Show, Eq)++instance Aeson.FromJSON Split where+ parseJSON (Aeson.Object v) = do+ name <- v .: "name"+ columns <- v .: "headers"+ rows <- v .: "rowSet"+ return Split {..}+ parseJSON invalid = Aeson.typeMismatch "Split" invalid++instance Aeson.ToJSON Split where+ toJSON Split {..} = Aeson.object [+ "name" .= name,+ "headers" .= columns,+ "rowSet" .= rows]++-- | An NBA Stats split name.+type SplitName = Text.Text++-- | A column name in an NBA Stats split.+type SplitColumn = Text.Text++-- | A row of data in an NBA Stats split.+type SplitRow = [Aeson.Value]++{- |+ An NBA Stats resource.++ This type represents the top-level JSON object returned from the NBA Stats REST API.+-}+data Stats =+ -- | Constructor for stats resource.+ Stats {+ -- | The resource's splits.+ splits :: [Split]+ }+ deriving (Show, Eq)++instance Aeson.ToJSON Stats where+ toJSON Stats {..} = Aeson.object [+ "resultSets" .= splits]++instance Aeson.FromJSON Stats where+ parseJSON (Aeson.Object o) = do+ splits <- o .: "resultSets"+ return Stats {..}+ parseJSON invalid = Aeson.typeMismatch "Stats" invalid++-- | A URL path for an NBA Stats resource.+type StatsPath = SBS.ByteString++-- | A collection of parameters that customize NBA Stats resources.+type StatsParameters = [(SBS.ByteString, Maybe SBS.ByteString)]++{- |+ An error which may be generated by this library.+-}+data StatsError =+ -- | An HTTP response has invalid JSON.+ StatsResponseDecodeFailure String |+ -- | A stats resource does not have a split matching the given split name.+ SplitNameNotFound String |+ -- | A split does not have a row matching the given column key and row value.+ SplitKeyNotFound String |+ -- | A split row has a different cardinality than the associated columns.+ SplitRowCardinalityInconsistent String |+ -- | A split does not have a column name matching the given key.+ SplitColumnNameNotFound String |+ -- | A failure to parse a split row's tabular data to the destination type.+ SplitRowParseFailure String+ deriving (Eq)++instance Show StatsError where+ show statsError = "StatsError (" ++ showCase statsError ++ ")"+ where+ showCase err = case err of+ StatsResponseDecodeFailure message -> format "StatsResponseDecodeFailure" message+ SplitNameNotFound message -> format "SplitNameNotFound" message+ SplitKeyNotFound message -> format "SplitKeyNotFound" message+ SplitRowCardinalityInconsistent message -> format "SplitRowCardinalityInconsistent" message+ SplitColumnNameNotFound message -> format "SplitColumnNameNotFound" message+ SplitRowParseFailure message -> format "SplitRowParseFailure" message+ format :: String -> String -> String+ format name message = name ++ " " ++ message++{- |+ Generates an HTTP GET request like the ones used internally.+-}+getRequest :: StatsPath -> HTTP.Request+getRequest path = HTTP.defaultRequest {+ HTTP.method = "GET",+ HTTP.secure = False,+ HTTP.host = domain,+ HTTP.path = "/stats/" <> path+}++{- |+ The NBA Stats domain name.+-}+domain :: SBS.ByteString+domain = "stats.nba.com"++parseSplitRow :: (Except.MonadError StatsError m, Aeson.FromJSON a) => [SplitColumn] -> SplitRow -> m a+parseSplitRow columns row =+ if length columns == length row+ then case Aeson.parse Aeson.parseJSON $ Aeson.object (zip columns row) of+ Aeson.Error message -> Except.throwError $ SplitRowParseFailure message+ Aeson.Success split -> return split+ else Except.throwError $ SplitRowCardinalityInconsistent $ show row++findSplit :: (Except.MonadError StatsError m) => HTTP.Response LBS.ByteString -> SplitName -> m Split+findSplit response splitName = do+ stats <- either+ (Except.throwError . StatsResponseDecodeFailure)+ return+ (Aeson.eitherDecode . HTTP.responseBody $ response)+ maybe+ (Except.throwError $ SplitNameNotFound $ Text.unpack splitName)+ return+ (List.find (\r -> name r == splitName) $ splits stats)++++get :: (Trans.MonadIO m, MonadHttp.MonadHttp m) => StatsPath -> StatsParameters -> m (HTTP.Response LBS.ByteString)+get path params = MonadHttp.performRequest $ HTTP.setQueryString params $ getRequest path++{- $use+ The following is a working example of getting some "advanced statistics", split by month, for the San Antonio Spurs 2015-2016 regular season.++ To learn how to find the NBA Stats values, like 'teamdashboardbygeneralsplits', for this example, read the <https://github.com/hamsterdam/kawhi/blob/development/guide.md guide>.++ @+ import qualified Data.Aeson as Aeson+ import qualified Data.Aeson.Types as Aeson+ import Data.Aeson ((.:))+ import qualified NBA.Stats as Stats++ main :: IO ()+ main = do+ eitherErrorOrStats <- advancedStatsByMonth+ case eitherErrorOrStats of+ Left statsError -> print statsError+ Right stats -> mapM_ print stats++ data AdvancedStats = AdvancedStats {+ month :: String,+ offensiveRating :: Double,+ defensiveRating :: Double+ } deriving (Show, Eq)++ instance Aeson.FromJSON AdvancedStats where+ parseJSON (Aeson.Object o) = do+ month <- o .: \"SEASON_MONTH_NAME\"+ offensiveRating <- o .: \"OFF_RATING\"+ defensiveRating <- o .: \"DEF_RATING\"+ return AdvancedStats {..}+ parseJSON invalid = Aeson.typeMismatch \"AdvancedStats\" invalid++ advancedStatsByMonth :: IO (Either Stats.StatsError [AdvancedStats])+ advancedStatsByMonth = Stats.getSplitRows \"teamdashboardbygeneralsplits\" \"MonthTeamDashboard\"+ [+ (\"Conference\", Nothing),+ (\"DateFrom\", Nothing),+ (\"DateTo\", Nothing),+ (\"Division\", Nothing),+ (\"GameScope\", Nothing),+ (\"GameSegment\", Nothing),+ (\"LastNGames\", Just \"0\"),+ (\"LeagueID\", Just \"00\"),+ (\"Location\", Nothing),+ (\"MeasureType\", Just \"Advanced\"),+ (\"Month\", Just \"0\"),+ (\"OpponentTeamID\", Just \"0\"),+ (\"Outcome\", Nothing),+ (\"PaceAdjust\", Just \"N\"),+ (\"PerMode\", Just \"PerGame\"),+ (\"Period\", Just \"0\"),+ (\"PlayerExperience\", Nothing),+ (\"PlayerPosition\", Nothing),+ (\"PlusMinus\", Just \"N\"),+ (\"PORound\", Just \"0\"),+ (\"Rank\", Just \"N\"),+ (\"Season\", Just \"2015-16\"),+ (\"SeasonSegment\", Nothing),+ (\"SeasonType\", Just \"Regular Season\"),+ (\"ShotClockRange\", Nothing),+ (\"StarterBench\", Nothing),+ (\"TeamID\", Just \"1610612759\"),+ (\"VsConference\", Nothing),+ (\"VsDivision\", Nothing)+ ]+ @++ This program's output at the time of writing is:++ @+ AdvancedStats {month = \"October\", offensiveRating = 102.7, defensiveRating = 93.4}+ AdvancedStats {month = \"November\", offensiveRating = 102.5, defensiveRating = 93.4}+ AdvancedStats {month = \"December\", offensiveRating = 111.8, defensiveRating = 91.5}+ AdvancedStats {month = \"January\", offensiveRating = 114.0, defensiveRating = 100.7}+ AdvancedStats {month = \"February\", offensiveRating = 110.7, defensiveRating = 99.1}+ AdvancedStats {month = \"March\", offensiveRating = 107.8, defensiveRating = 97.2}+ AdvancedStats {month = \"April\", offensiveRating = 102.3, defensiveRating = 103.5}+ @+-}
+ tests/NBA/Stats/Tests.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module NBA.Stats.Tests where++import qualified Control.Monad.Except as Except+import qualified Control.Monad.Http as MonadHttp+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import Data.Aeson ((.:))+import qualified Data.ByteString.Char8 as Char8+import qualified Data.ByteString.Lazy as ByteString+import Data.Monoid ((<>))+import qualified Data.Scientific as Sci+import qualified Data.Text as Text+import qualified Network.HTTP.Client.Internal as HTTP+import qualified Network.HTTP.Types as HTTP+import qualified NBA.Stats as Stats+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as HUnit+import qualified Test.Tasty.SmallCheck as SC+import Test.Tasty.HUnit ((@?=))++tests :: Tasty.TestTree+tests = Tasty.testGroup "NBA.Stats" [+ SC.testProperty "getRequest == HTTP.parseUrl" $+ \path -> SC.monadic $ do+ let request = Stats.getRequest $ Char8.pack path+ model <- HTTP.parseUrl $ "http://stats.nba.com/stats/" <> path+ return $ show request == show model,+ propertyStatsErrorShow Stats.StatsResponseDecodeFailure "StatsResponseDecodeFailure",+ propertyStatsErrorShow Stats.SplitNameNotFound "SplitNameNotFound",+ propertyStatsErrorShow Stats.SplitKeyNotFound "SplitKeyNotFound",+ propertyStatsErrorShow Stats.SplitColumnNameNotFound "SplitColumnNameNotFound",+ propertyStatsErrorShow Stats.SplitRowCardinalityInconsistent "SplitRowCardinalityInconsistent",+ propertyStatsErrorShow Stats.SplitRowParseFailure "SplitRowParseFailure",++ getSplitRowExpectSuccess+ "Success"+ (defaultResponseBody [defaultSplit])+ defaultModel,++ getSplitRowsExpectSuccess+ "Success"+ (defaultResponseBody [defaultSplit { Stats.rows = [defaultRow, defaultRow] }])+ [defaultModel, defaultModel],++ getSplitRowExpectFailure+ "SplitRowCardinalityInconsistent"+ (defaultResponseBody [defaultSplit { Stats.rows = [take 3 defaultRow] }])+ (Stats.SplitRowCardinalityInconsistent $ show $ take 3 defaultRow),++ getSplitRowExpectFailure+ "SplitKeyNotFound (no rows)"+ (defaultResponseBody [defaultSplit { Stats.rows = [] }])+ (Stats.SplitKeyNotFound $ show defaultRowIdentifier),++ getSplitRowExpectFailure+ "SplitKeyNotFound (no key value)"+ (defaultResponseBody [defaultSplit { Stats.rows = [[]] }])+ (Stats.SplitKeyNotFound $ show defaultRowIdentifier),++ getSplitRowExpectFailure+ "SplitKeyNotFound (JSON parse error for key value)"+ (let rowWithBadValue = Aeson.Number 99 : defaultRow in defaultResponseBody [defaultSplit { Stats.rows = [rowWithBadValue] }])+ (Stats.SplitKeyNotFound $ show defaultRowIdentifier),++ getSplitRowExpectFailure+ "SplitNameNotFound"+ (defaultResponseBody [])+ (Stats.SplitNameNotFound $ Text.unpack defaultSplitName),++ getSplitRowExpectFailure+ "SplitColumnNameNotFound"+ (defaultResponseBody [defaultSplit { Stats.columns = [] }])+ (Stats.SplitColumnNameNotFound $ Text.unpack defaultColumnsKey),++ getSplitRowExpectFailure+ "SplitRowParseFailure (type mismatch)"+ (defaultResponseBody [defaultSplit { Stats.rows = [[Aeson.String defaultRowIdentifier, Aeson.String $ Text.pack $ show (a defaultModel), Aeson.String $ b defaultModel, Aeson.Number $ Sci.fromFloatDigits (c defaultModel)]] }])+ (Stats.SplitRowParseFailure "failed to parse field A: expected Integral, encountered String"),++ getSplitRowExpectFailure+ "SplitRowParseFailure (missing field)"+ (defaultResponseBody [defaultSplit { Stats.columns = fmap (\c -> if c == "B" then "!B" else c) defaultColumns }])+ (Stats.SplitRowParseFailure "key \"B\" not present"),++ getSplitRowExpectFailure+ "StatsResponseDecodeFailure (for Stats)"+ (Aeson.encode [defaultSplit])+ (Stats.StatsResponseDecodeFailure "Error in $: expected Stats, encountered Array"),++ HUnit.testCase+ "parseJSON invalid :: Parser Split -> Error"+ (case Aeson.fromJSON $ Aeson.String "foo" :: Aeson.Result Stats.Split of+ Aeson.Success _ -> HUnit.assertFailure "Parse should not have succeeded"+ Aeson.Error e -> e @?= "expected Split, encountered String")+ ]++propertyStatsErrorShow :: Show a => (String -> a) -> String -> Tasty.TestTree+propertyStatsErrorShow constructor exception =+ SC.testProperty testName property+ where+ testName = "show (" ++ exception ++ " message) == \"StatsError (" ++ exception ++ " message)\""+ property message = show (constructor message) == "StatsError (" ++ exception ++ " " ++ message ++ ")"++getSplitRowExpectFailure :: Tasty.TestName -> ByteString.ByteString -> Stats.StatsError -> Tasty.TestTree+getSplitRowExpectFailure testName responseBody expected = HUnit.testCase ("Get stat -> " <> testName) $ do+ eitherModel <- runStatsTest $ runAction statAction responseBody HTTP.ok200+ case eitherModel of+ Left err -> err @?= expected+ Right model -> HUnit.assertFailure $ show model++expectSuccess :: (Eq a, Show a) => MonadHttp.HttpT StatsTest a -> Tasty.TestName -> ByteString.ByteString -> a -> Tasty.TestTree+expectSuccess action testName responseBody expected =+ HUnit.testCase testName $ do+ eitherModel <- runStatsTest $ runAction action responseBody HTTP.ok200+ case eitherModel of+ Left err -> HUnit.assertFailure $ show err+ Right actual -> actual @?= expected++getSplitRowsExpectSuccess :: Tasty.TestName -> ByteString.ByteString -> [MockModel] -> Tasty.TestTree+getSplitRowsExpectSuccess name = expectSuccess (Stats.getSplitRowsGeneric "mockmodels" defaultSplitName defaultParams) $ "Get stats -> " <> name++getSplitRowExpectSuccess :: Tasty.TestName -> ByteString.ByteString -> MockModel -> Tasty.TestTree+getSplitRowExpectSuccess name = expectSuccess statAction $ "Get stat -> " <> name++statAction :: MonadHttp.HttpT StatsTest MockModel+statAction = Stats.getSplitRowGeneric "mockmodels" defaultSplitName defaultColumnsKey defaultRowIdentifier defaultParams++runAction :: MonadHttp.HttpT StatsTest a -> ByteString.ByteString -> HTTP.Status -> StatsTest a+runAction action responseBody responseStatus = MonadHttp.runHttpT+ action+ HTTP.Response {+ HTTP.responseStatus = responseStatus,+ HTTP.responseVersion = HTTP.http11,+ HTTP.responseHeaders = [],+ HTTP.responseBody = responseBody,+ HTTP.responseCookieJar = HTTP.createCookieJar [],+ HTTP.responseClose' = HTTP.ResponseClose (return () :: IO ())+ }++defaultParams :: Stats.StatsParameters+defaultParams = [("param", Just "value")]++defaultResponseBody :: [Stats.Split] -> ByteString.ByteString+defaultResponseBody splits = Aeson.encode defaultStats { Stats.splits = splits }++defaultStats :: Stats.Stats+defaultStats = Stats.Stats {+ splits = []+}++defaultSplit :: Stats.Split+defaultSplit = Stats.Split {+ name = defaultSplitName,+ columns = defaultColumns,+ rows = [defaultRow]+}++defaultSplitName :: Stats.SplitName+defaultSplitName = "name"++defaultColumnsKey :: Stats.SplitColumn+defaultColumnsKey = "key"++defaultRowIdentifier :: Text.Text+defaultRowIdentifier = "identifier"++defaultColumns :: [Stats.SplitColumn]+defaultColumns = [defaultColumnsKey, "A", "B", "C"]++defaultRow :: Stats.SplitRow+defaultRow = [Aeson.String defaultRowIdentifier, Aeson.Number $ Sci.scientific (a defaultModel) 0, Aeson.String $ b defaultModel, Aeson.Number $ Sci.fromFloatDigits (c defaultModel)]++defaultModel :: MockModel+defaultModel = MockModel { a = 1, b = "1", c = 1.1 }++type StatsTest = Except.ExceptT Stats.StatsError IO++runStatsTest :: StatsTest a -> IO (Either Stats.StatsError a)+runStatsTest = Except.runExceptT++data MockModel = MockModel {+ a :: Integer,+ b :: Text.Text,+ c :: Double+} deriving (Show, Eq)++instance Aeson.FromJSON MockModel where+ parseJSON (Aeson.Object o) = do+ a <- o .: "A"+ b <- o .: "B"+ c <- o .: "C"+ return MockModel {..}+ parseJSON invalid = Aeson.typeMismatch "MockModel" invalid
+ tests/Tests.hs view
@@ -0,0 +1,6 @@+import qualified Test.Tasty as Tasty++import qualified NBA.Stats.Tests as Stats++main :: IO ()+main = Tasty.defaultMain Stats.tests