yesod-filter-0.1.0.0: test/Yesod/Filter/InternalSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Yesod.Filter.InternalSpec (spec) where
import Control.Monad (forM_, (>=>))
import Data.Either (isLeft, partitionEithers)
import Data.Text (Text)
import Data.Time (TimeOfDay (TimeOfDay), UTCTime (UTCTime), fromGregorian,
timeOfDayToTime)
import Database.Persist (Filter, SelectOpt (Asc, Desc, LimitTo, OffsetBy), (!=.),
(<.), (<=.), (==.), (>.), (>=.))
import Test.Hspec
import Yesod.Filter.Internal
import Yesod.Filter.TH (PageLimit (LIMIT, NoLimit), PageOffset (NoOffset, OFFSET),
mkToFilterValueInstances)
import Yesod.Filter.TestTypes
$(mkToFilterValueInstances "Foo")
spec :: Spec
spec = do
describe "getFilters" $ do
context "for not nullable fields" $ do
let tests =
[ ( [("ctxt", toFilterValue >=> (Just . (==.) FooCtxt))]
, [("ctxt", "foo")]
, [Right (FooCtxt ==. "foo")]
)
, ( [("cint", toFilterValue >=> (Just . (==.) FooCint))]
, [("cint", "1")]
, [Right (FooCint ==. 1)]
)
, ( [("cdbl", toFilterValue >=> (Just . (==.) FooCdbl))]
, [("cdbl", "1.0")]
, [Right (FooCdbl ==. 1.0)]
)
, ( [("cbol", toFilterValue >=> (Just . (==.) FooCbol))]
, [("cbol", "true")]
, [Right (FooCbol ==. True)]
)
, ( [("cday", toFilterValue >=> (Just . (==.) FooCday))]
, [("cday", "2020-01-01")]
, [Right (FooCday ==. fromGregorian 2020 1 1)]
)
, ( [("ctod", toFilterValue >=> (Just . (==.) FooCtod))]
, [("ctod", "12:34:56")]
, [Right (FooCtod ==. TimeOfDay 12 34 56)]
)
, ( [("cutm", toFilterValue >=> (Just . (==.) FooCutm))]
, [("cutm", "2020-01-01T12:34:56Z")]
, [Right (FooCutm ==. UTCTime (fromGregorian 2020 1 1 ) (timeOfDayToTime $ TimeOfDay 12 34 56))]
)
]
forM_ tests $ \(availableFilters, params, ret) ->
it ("returns " ++ show ret ++ " for " ++ show params) $
getFilters availableFilters params `shouldBe` ret
context "for nullable fields" $ do
let tests =
[ ( [("mtxt", toFilterValue >=> (Just . (==.) FooMtxt))]
, [("mtxt", "foo")]
, [Right (FooMtxt ==. Just "foo")]
)
, ( [("mint", toFilterValue >=> (Just . (==.) FooMint))]
, [("mint", "1")]
, [Right (FooMint ==. Just 1)]
)
, ( [("mdbl", toFilterValue >=> (Just . (==.) FooMdbl))]
, [("mdbl", "1.0")]
, [Right (FooMdbl ==. Just 1.0)]
)
, ( [("mbol", toFilterValue >=> (Just . (==.) FooMbol))]
, [("mbol", "true")]
, [Right (FooMbol ==. Just True)]
)
, ( [("mday", toFilterValue >=> (Just . (==.) FooMday))]
, [("mday", "2020-01-01")]
, [Right (FooMday ==. (Just $ fromGregorian 2020 1 1))]
)
, ( [("mtod", toFilterValue >=> (Just . (==.) FooMtod))]
, [("mtod", "12:34:56")]
, [Right (FooMtod ==. (Just $ TimeOfDay 12 34 56))]
)
, ( [("mutm", toFilterValue >=> (Just . (==.) FooMutm))]
, [("mutm", "2020-01-01T12:34:56Z")]
, [Right (FooMutm ==. (Just $ UTCTime (fromGregorian 2020 1 1 ) (timeOfDayToTime $ TimeOfDay 12 34 56)))]
)
]
forM_ tests $ \(availableFilters, params, ret) ->
it ("returns " ++ show ret ++ " for " ++ show params) $
getFilters availableFilters params `shouldBe` ret
context "for not nullable fields with various operators" $ do
let tests =
[ ( [("cint", toFilterValue >=> (Just . (==.) FooCint))]
, [("cint", "1")]
, [Right (FooCint ==. 1)]
)
, ( [("cint__ne", toFilterValue >=> (Just . (!=.) FooCint))]
, [("cint__ne", "1")]
, [Right (FooCint !=. 1)]
)
, ( [("cint__gt", toFilterValue >=> (Just . (>.) FooCint))]
, [("cint__gt", "1")]
, [Right (FooCint >. 1)]
)
, ( [("cint__lt", toFilterValue >=> (Just . (<.) FooCint))]
, [("cint__lt", "1")]
, [Right (FooCint <. 1)]
)
, ( [("cint__ge", toFilterValue >=> (Just . (>=.) FooCint))]
, [("cint__ge", "1")]
, [Right (FooCint >=. 1)]
)
, ( [("cint__le", toFilterValue >=> (Just . (<=.) FooCint))]
, [("cint__le", "1")]
, [Right (FooCint <=. 1)]
)
]
forM_ tests $ \(availableFilters, params, ret) ->
it ("returns " ++ show ret ++ " for " ++ show params) $
getFilters availableFilters params `shouldBe` ret
context "for not nullable fields with various operators" $ do
let tests =
[ ( [("mint", toFilterValue >=> (Just . (==.) FooMint))]
, [("mint", "1")]
, [Right (FooMint ==. Just 1)]
)
, ( [("mint__ne", toFilterValue >=> (Just . (!=.) FooMint))]
, [("mint__ne", "1")]
, [Right (FooMint !=. Just 1)]
)
, ( [("mint__gt", toFilterValue >=> (Just . (>.) FooMint))]
, [("mint__gt", "1")]
, [Right (FooMint >. Just 1)]
)
, ( [("mint__lt", toFilterValue >=> (Just . (<.) FooMint))]
, [("mint__lt", "1")]
, [Right (FooMint <. Just 1)]
)
, ( [("mint__ge", toFilterValue >=> (Just . (>=.) FooMint))]
, [("mint__ge", "1")]
, [Right (FooMint >=. Just 1)]
)
, ( [("mint__le", toFilterValue >=> (Just . (<=.) FooMint))]
, [("mint__le", "1")]
, [Right (FooMint <=. Just 1)]
)
, ( [("mint__isnull", toFilterValue >=> (\b -> Just $ (if b then (==.) else (!=.)) FooMint Nothing))]
, [("mint__isnull", "true")]
, [Right (FooMint ==. Nothing)]
)
]
forM_ tests $ \(availableFilters, params, ret) ->
it ("returns " ++ show ret ++ " for " ++ show params) $
getFilters availableFilters params `shouldBe` ret
context "for invalid value type" $ do
let tests =
[ ( [("cint", toFilterValue >=> (Just . (==.) FooCint))]
, [("cint", "foo")]
)
, ( [("cdbl", toFilterValue >=> (Just . (==.) FooCdbl))]
, [("cdbl", "foo")]
)
, ( [("cbol", toFilterValue >=> (Just . (==.) FooCbol))]
, [("cbol", "foo")]
)
, ( [("cday", toFilterValue >=> (Just . (==.) FooCday))]
, [("cday", "foo")]
)
, ( [("ctod", toFilterValue >=> (Just . (==.) FooCtod))]
, [("ctod", "foo")]
)
, ( [("cutm", toFilterValue >=> (Just . (==.) FooCutm))]
, [("cutm", "foo")]
)
, ( [("mint", toFilterValue >=> (Just . (==.) FooMint))]
, [("mint", "foo")]
)
, ( [("mdbl", toFilterValue >=> (Just . (==.) FooMdbl))]
, [("mdbl", "foo")]
)
, ( [("mbol", toFilterValue >=> (Just . (==.) FooMbol))]
, [("mbol", "foo")]
)
, ( [("mday", toFilterValue >=> (Just . (==.) FooMday))]
, [("mday", "foo")]
)
, ( [("mtod", toFilterValue >=> (Just . (==.) FooMtod))]
, [("mtod", "foo")]
)
, ( [("mutm", toFilterValue >=> (Just . (==.) FooMutm))]
, [("mutm", "foo")]
)
]
forM_ tests $ \(availableFilters, params) ->
it ("returns Left for " ++ show params) $
getFilters availableFilters params `shouldSatisfy` isALeft
it "returns [] if params is []" $
getFilters [("ctxt", toFilterValue >=> (Just . (==.) FooCtxt))] []
`shouldBe` []
it "returns Left if the field has no available filter" $
getFilters [("ctxt", toFilterValue >=> (Just . (==.) FooCtxt))] [("cint", "1")]
`shouldSatisfy` isALeft
it "returns multiple filters for multiple parameters" $ do
let
availableFilters =
[ ("ctxt", toFilterValue >=> (Just . (==.) FooCtxt))
, ("cdbl", toFilterValue >=> (Just . (==.) FooCdbl))
, ("mint__isnull", toFilterValue >=> (\b -> Just $ (if b then (==.) else (!=.)) FooMint Nothing))
]
params =
[ ("ctxt", "foo")
, ("cdbl", "1.0")
, ("mint__isnull", "true")
]
getFilters availableFilters params `shouldMatchList`
[ Right (FooCtxt ==. "foo")
, Right (FooCdbl ==. 1.0)
, Right (FooMint ==. Nothing)
]
it "returns a list of mixed Right and Left if the parameters contain an invalid value" $ do
let
availableFilters =
[ ("ctxt", toFilterValue >=> (Just . (==.) FooCtxt))
, ("cdbl", toFilterValue >=> (Just . (==.) FooCdbl))
, ("mint__isnull", toFilterValue >=> (\b -> Just $ (if b then (==.) else (!=.)) FooMint Nothing))
]
params =
[ ("ctxt", "foo")
, ("cdbl", "foo")
, ("mint__isnull", "true")
]
result = getFilters availableFilters params
(ls, rs) = partitionEithers result
rs `shouldMatchList`
[ FooCtxt ==. "foo"
, FooMint ==. Nothing
]
ls `shouldSatisfy` (1 ==) . length
describe "getOrderBy" $ do
context "Right cases" $ do
let tests =
[ (Just $ Asc FooCtxt, [("cint", Asc FooCint)], Just "cint", Right $ Just $ Asc FooCint)
, (Nothing, [("cint", Asc FooCint)], Just "cint", Right $ Just $ Asc FooCint)
, (Just $ Asc FooCtxt, [("cint", Asc FooCint)], Nothing, Right $ Just $ Asc FooCtxt)
, (Just $ Asc FooCtxt, [], Nothing, Right $ Just $ Asc FooCtxt)
, (Nothing, [("cint", Asc FooCint)], Nothing, Right Nothing)
, (Just $ Desc FooCtxt, [("-cint", Desc FooCint)], Just "-cint", Right $ Just $ Desc FooCint)
, (Nothing, [("-cint", Desc FooCint)], Just "-cint", Right $ Just $ Desc FooCint)
, (Just $ Desc FooCtxt, [("-cint", Desc FooCint)], Nothing, Right $ Just $ Desc FooCtxt)
, (Just $ Desc FooCtxt, [], Nothing, Right $ Just $ Desc FooCtxt)
, (Nothing, [("-cint", Desc FooCint)], Nothing, Right Nothing)
, (Nothing, [], Nothing, Right Nothing)
]
forM_ tests $ \(defaultOrderBy, availableOrderBys, msort, ret) ->
it ("returns " ++ show ret ++ " for " ++ show defaultOrderBy ++ ", " ++ show availableOrderBys ++ ", " ++ show msort) $
getOrderBy defaultOrderBy availableOrderBys msort `shouldBe` ret
context "Left cases" $ do
let tests =
[ (Just $ Asc FooCtxt, [], Just "cint")
, (Nothing, [], Just "cint")
, (Just $ Asc FooCtxt, [("ctxt", Asc FooCtxt)], Just "cint")
, (Nothing, [("ctxt", Asc FooCtxt)], Just "cint")
]
forM_ tests $ \(defaultOrderBy, availableOrderBys, msort) ->
it ("returns Left for " ++ show defaultOrderBy ++ ", " ++ show availableOrderBys ++ ", " ++ show msort) $
getOrderBy defaultOrderBy availableOrderBys msort `shouldSatisfy` isLeft
describe "getOffsetBy" $ do
context "Right cases" $ do
let tests =
[ (OFFSET 0, Just "1", Right $ Just $ OffsetBy 1)
, (NoOffset, Just "1", Right $ Just $ OffsetBy 1)
, (OFFSET 0, Nothing, Right $ Just $ OffsetBy 0)
, (NoOffset, Nothing, Right Nothing)
]
forM_ tests $ \(defaultOffset', moffset, ret) ->
it ("returns " ++ show ret ++ " for " ++ show defaultOffset' ++ ", " ++ show moffset) $
getOffsetBy defaultOffset' moffset `shouldBe` (ret :: Either Text (Maybe (SelectOpt Foo)))
context "Left cases" $ do
let tests =
[ (OFFSET 0, Just "foo")
, (NoOffset, Just "foo")
]
forM_ tests $ \(defaultOffset', moffset) ->
it ("returns Left for " ++ show defaultOffset' ++ ", " ++ show moffset) $
(getOffsetBy defaultOffset' moffset :: Either Text (Maybe (SelectOpt Foo))) `shouldSatisfy` isLeft
describe "getLimitTo" $ do
context "Right cases" $ do
let tests =
[ (LIMIT 0, Just "1", Right $ Just $ LimitTo 1)
, (NoLimit, Just "1", Right $ Just $ LimitTo 1)
, (LIMIT 0, Nothing, Right $ Just $ LimitTo 0)
, (NoLimit, Nothing, Right Nothing)
]
forM_ tests $ \(defaultLimit', mlimit, ret) ->
it ("returns " ++ show ret ++ " for " ++ show defaultLimit' ++ ", " ++ show mlimit) $
getLimitTo defaultLimit' mlimit `shouldBe` (ret :: Either Text (Maybe (SelectOpt Foo)))
context "Left cases" $ do
let tests =
[ (LIMIT 0, Just "foo")
, (NoLimit, Just "foo")
]
forM_ tests $ \(defaultLimit', mlimit) ->
it ("returns Left for " ++ show defaultLimit' ++ ", " ++ show mlimit) $
(getLimitTo defaultLimit' mlimit :: Either Text (Maybe (SelectOpt Foo))) `shouldSatisfy` isLeft
isALeft :: [Either Text (Filter record)] -> Bool
isALeft [x] = isLeft x
isALeft _ = False