diff options
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous/OrphansSpec.hs')
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/OrphansSpec.hs | 72 |
1 files changed, 0 insertions, 72 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs b/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs deleted file mode 100644 index 0d800e8a91de..000000000000 --- a/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE OverloadedLists #-} --------------------------------------------------------------------------------- -module Xanthous.OrphansSpec where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import Text.Mustache -import Text.Megaparsec (errorBundlePretty) -import Graphics.Vty.Attributes -import qualified Data.Aeson as JSON -import Data.Interval (Interval, (<=..<=), (<=..<), (<..<=)) -import Data.Aeson ( ToJSON(toJSON), object, Value(Array) ) -import Data.Aeson.Types (fromJSON) -import Data.IntegerInterval (Extended(Finite)) --------------------------------------------------------------------------------- -import Xanthous.Orphans --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Orphans" - [ localOption (QuickCheckTests 50) - . localOption (QuickCheckMaxSize 10) - $ testGroup "Template" - [ testProperty "ppTemplate / compileMustacheText " \tpl -> - let src = ppTemplate tpl - res :: Either String Template - res = over _Left errorBundlePretty - $ compileMustacheText (templateActual tpl) src - expected = templateCache tpl ^?! at (templateActual tpl) - in - counterexample (unpack src) - $ Right expected === do - (Template actual cache) <- res - maybe (Left "Template not found") Right $ cache ^? at actual - , testProperty "JSON round trip" $ \(tpl :: Template) -> - counterexample (unpack $ ppTemplate tpl) - $ JSON.decode (JSON.encode tpl) === Just tpl - ] - , testGroup "Attr" - [ jsonRoundTrip @Attr ] - , testGroup "Extended" - [ jsonRoundTrip @(Extended Int) ] - , testGroup "Interval" - [ testGroup "JSON" - [ jsonRoundTrip @(Interval Int) - , testCase "parses a single value as a length-1 interval" $ - getSuccess (fromJSON $ toJSON (1 :: Int)) - @?= Just (Finite (1 :: Int) <=..<= Finite 1) - , testCase "parses a pair of values as a single-ended interval" $ - getSuccess (fromJSON $ toJSON ([1, 2] :: [Int])) - @?= Just (Finite (1 :: Int) <=..< Finite (2 :: Int)) - , testCase "parses the full included/excluded syntax" $ - getSuccess (fromJSON $ Array [ object [ "Excluded" JSON..= (1 :: Int) ] - , object [ "Included" JSON..= (4 :: Int) ] - ]) - @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int)) - , testCase "parses open/closed as aliases" $ - getSuccess (fromJSON $ Array [ object [ "Open" JSON..= (1 :: Int) ] - , object [ "Closed" JSON..= (4 :: Int) ] - ]) - @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int)) - ] - ] - ] - where - getSuccess :: JSON.Result a -> Maybe a - getSuccess (JSON.Error _) = Nothing - getSuccess (JSON.Success r) = Just r |