{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Test.Aeson.Internal.Utils where
import Control.Exception
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Proxy
import Data.Typeable
import Prelude
import Test.Hspec
import Test.QuickCheck
data ComparisonFile
= FaultyFile
| OverwriteGoldenFile
data Settings = Settings
{ goldenDirectoryOption :: GoldenDirectoryOption
, useModuleNameAsSubDirectory :: Bool
, sampleSize :: Int
, comparisonFile :: ComparisonFile
}
data GoldenDirectoryOption = CustomDirectoryName String | GoldenDirectory
defaultSettings :: Settings
defaultSettings = Settings GoldenDirectory False 5 FaultyFile
addBrackets :: String -> String
addBrackets s =
if ' ' `elem` s
then "(" ++ s ++ ")"
else s
shouldBeIdentity :: (Eq a, Show a, Arbitrary a) =>
Proxy a -> (a -> IO a) -> Property
shouldBeIdentity Proxy function =
property $ \ (a :: a) -> function a `shouldReturn` a
checkAesonEncodingEquality :: forall a . (ToJSON a, FromJSON a) => JsonShow a -> Bool
checkAesonEncodingEquality (JsonShow a) =
let byteStrA = encode a
decodedVal = (eitherDecode byteStrA) :: Either String a
eitherByteStrB = encode <$> decodedVal
in (Right byteStrA) == eitherByteStrB
aesonDecodeIO :: FromJSON a => ByteString -> IO a
aesonDecodeIO bs = case eitherDecode bs of
Right a -> return a
Left msg -> throwIO $ ErrorCall
("aeson couldn't parse value: " ++ msg)
newtype JsonShow a = JsonShow a
instance ToJSON a => Show (JsonShow a) where
show (JsonShow v) = show . encode $ v
instance ToJSON a => ToJSON (JsonShow a) where
toJSON (JsonShow a) = toJSON a
instance FromJSON a => FromJSON (JsonShow a) where
parseJSON v = JsonShow <$> (parseJSON v)
instance Arbitrary a => Arbitrary (JsonShow a) where
arbitrary = JsonShow <$> arbitrary
newtype TopDir =
TopDir
{ unTopDir :: FilePath
} deriving (Eq,Read,Show)
newtype ModuleName =
ModuleName
{ unModuleName :: FilePath
} deriving (Eq,Read,Show)
newtype TypeName =
TypeName
{ unTypeName :: FilePath
} deriving (Eq,Read,Show)
data TypeNameInfo a =
TypeNameInfo
{ typeNameTopDir :: TopDir
, typeNameModuleName :: Maybe ModuleName
, typeNameTypeName :: TypeName
} deriving (Eq,Read,Show)
mkTypeNameInfo :: forall a . Arbitrary a => Typeable a => Settings -> Proxy a -> IO (TypeNameInfo a)
mkTypeNameInfo (Settings { useModuleNameAsSubDirectory
, goldenDirectoryOption}) proxy = do
maybeModuleName <- maybeModuleNameIO
return $ TypeNameInfo (TopDir topDir )
(ModuleName <$> maybeModuleName )
(TypeName typeName)
where
typeName = show (typeRep proxy)
maybeModuleNameIO =
if useModuleNameAsSubDirectory
then do
arbA <- generate (arbitrary :: Gen a)
return $ Just $ tyConModule . typeRepTyCon . typeOf $ arbA
else return Nothing
topDir =
case goldenDirectoryOption of
GoldenDirectory -> "golden"
CustomDirectoryName d -> d