hs-mesos-0.20.0.0: test/Main.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import           Control.Applicative
import           Control.Monad.Managed
import qualified Data.ByteString              as ByteString
import           Data.IORef
import           Foreign.C.Types
import           System.Mesos.Internal
import           System.Mesos.Raw.Attribute
import           System.Mesos.Raw.Environment
import           System.Mesos.Raw.Parameter
import           System.Mesos.Raw.Parameters
import           System.Mesos.Scheduler
import           System.Mesos.Types
import           Test.QuickCheck
import           Test.QuickCheck.Arbitrary
import           Test.QuickCheck.Monadic

markCalled r = modifyIORef r (+1)

beforeAndAfter :: (Show a, CPPValue a) => a -> IO a
beforeAndAfter x = do
  print x
  x' <- with (cppValue x >>= unmarshal) return
  print x'
  return x'

main :: IO ()
main = testIDs

instance Arbitrary CUInt where
  arbitrary = CUInt <$> arbitrary
instance Arbitrary CULong where
  arbitrary = CULong <$> arbitrary
instance Arbitrary ByteString.ByteString where
  arbitrary = ByteString.pack <$> arbitrary
instance CoArbitrary ByteString.ByteString where
  coarbitrary = coarbitrary . ByteString.unpack
deriving instance Arbitrary FrameworkID
deriving instance Arbitrary OfferID
deriving instance Arbitrary SlaveID
deriving instance Arbitrary TaskID
deriving instance Arbitrary ExecutorID
deriving instance Arbitrary ContainerID
instance Arbitrary FrameworkInfo where
  arbitrary = FrameworkInfo
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary CommandURI where
  arbitrary = CommandURI <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary CommandValue where
  arbitrary = oneof
    [ ShellCommand <$> arbitrary
    , RawCommand <$> arbitrary <*> arbitrary
    ]

instance Arbitrary CommandInfo where
  arbitrary = CommandInfo <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary ExecutorInfo where
  arbitrary = ExecutorInfo
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary MasterInfo where
  arbitrary = MasterInfo
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary SlaveInfo where
  arbitrary = SlaveInfo
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary Value where
  arbitrary = oneof
    [ Scalar <$> arbitrary
    , Ranges <$> listOf range
    , Set <$> listOf arbitrary
    , Text <$> arbitrary
    ]
    where range = arbitrary >>= \l -> arbitrary >>= \r -> return (l, r)

instance Arbitrary Attribute where
  arbitrary = Attribute <$> arbitrary <*> arbitrary

instance Arbitrary Resource where
  arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary PerformanceStatistics where
  arbitrary = PerformanceStatistics
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary ResourceStatistics where
  arbitrary = ResourceStatistics
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary ResourceUsage where
  arbitrary = ResourceUsage
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary Request where
  arbitrary = Request
    <$> arbitrary
    <*> arbitrary

instance Arbitrary Offer where
  arbitrary = Offer
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary TaskExecutionInfo where
  arbitrary = oneof
    [ TaskCommand <$> arbitrary
    , TaskExecutor <$> arbitrary
    ]

instance Arbitrary Mode where
  arbitrary = oneof [pure ReadWrite, pure ReadOnly]

instance Arbitrary Volume where
  arbitrary = Volume <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary ContainerType where
  arbitrary = Docker <$> arbitrary

instance Arbitrary ContainerInfo where
  arbitrary = ContainerInfo <$> arbitrary <*> arbitrary

instance Arbitrary HealthCheckStrategy where
  arbitrary = oneof
    [ CommandCheck <$> arbitrary
    , HTTPCheck <$> arbitrary <*> arbitrary <*> arbitrary
    ]

instance Arbitrary HealthCheck where
  arbitrary = HealthCheck
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary TaskInfo where
  arbitrary = TaskInfo
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary TaskState where
  arbitrary = elements [Staging, Starting, TaskRunning, Finished, Failed, Killed, Lost]

instance Arbitrary TaskStatus where
  arbitrary = TaskStatus
    <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary

instance Arbitrary Filters where
  arbitrary = Filters <$> arbitrary
instance Arbitrary Environment where
  arbitrary = Environment <$> arbitrary
instance Arbitrary Parameter where
  arbitrary = Parameter <$> arbitrary <*> arbitrary
instance Arbitrary Parameters where
  arbitrary = Parameters <$> arbitrary
instance Arbitrary Credential where
  arbitrary = Credential <$> arbitrary <*> arbitrary

idempotentMarshalling :: (Show a, Eq a, CPPValue a) => a -> IO a
idempotentMarshalling x = with (cppValue x >>= unmarshal) return

prop_idempotentMarshalling :: (Show a, Eq a, CPPValue a) => Gen a -> Property
prop_idempotentMarshalling g = monadicIO $ forAllM g $ \x -> do
  res <- Test.QuickCheck.Monadic.run $ idempotentMarshalling x
  -- Test.QuickCheck.Monadic.run $ print x
  if equalExceptDefaults x res
    then assert True
    else do
      Test.QuickCheck.Monadic.run $ do
        putStrLn "Original"
        print x
        putStrLn "Unmarshalled"
        print res
      assert False

qcIM :: (Show a, Eq a, CPPValue a) => Gen a -> IO ()
qcIM = quickCheck . prop_idempotentMarshalling

testIDs = do
  putStrLn "Testing ExecutorInfo"
  qcIM (arbitrary :: Gen ExecutorInfo)
  putStrLn "Testing TaskInfo"
  qcIM (arbitrary :: Gen TaskInfo)
  putStrLn "Testing Volume"
  qcIM (arbitrary :: Gen Volume)
  putStrLn "Testing HealthCheck"
  qcIM (arbitrary :: Gen HealthCheck)
  putStrLn "Testing ContainerInfo"
  qcIM (arbitrary :: Gen ContainerInfo)
  putStrLn "Testing Value"
  qcIM (arbitrary :: Gen Value)
  putStrLn "Testing FrameworkID"
  qcIM (arbitrary :: Gen FrameworkID)
  putStrLn "Testing OfferID"
  qcIM (arbitrary :: Gen OfferID)
  putStrLn "Testing SlaveID"
  qcIM (arbitrary :: Gen SlaveID)
  putStrLn "Testing TaskID"
  qcIM (arbitrary :: Gen TaskID)
  putStrLn "Testing ExecutorID"
  qcIM (arbitrary :: Gen ExecutorID)
  putStrLn "Testing ContainerID"
  qcIM (arbitrary :: Gen ContainerID)
  putStrLn "Testing Filters"
  qcIM (arbitrary :: Gen Filters)
  putStrLn "Testing Environment"
  qcIM (arbitrary :: Gen Environment)
  putStrLn "Testing FrameworkInfo"
  qcIM (arbitrary :: Gen FrameworkInfo)
  putStrLn "Testing CommandURI"
  qcIM (arbitrary :: Gen CommandURI)
  putStrLn "Testing Credential"
  qcIM (arbitrary :: Gen Credential)
  putStrLn "Testing TaskStatus"
  qcIM (arbitrary :: Gen TaskStatus)
  putStrLn "Testing ResourceUsage"
  qcIM (arbitrary :: Gen ResourceUsage)
  putStrLn "Testing ResourceStatistics"
  qcIM (arbitrary :: Gen ResourceStatistics)
  putStrLn "Testing Parameters"
  qcIM (arbitrary :: Gen Parameters)
  putStrLn "Testing Attribute"
  qcIM (arbitrary :: Gen Attribute)
  putStrLn "Testing Resource"
  qcIM (arbitrary :: Gen Resource)
  putStrLn "Testing CommandInfo"
  qcIM (arbitrary :: Gen CommandInfo)
  putStrLn "Testing MasterInfo"
  qcIM (arbitrary :: Gen MasterInfo)
  putStrLn "Testing Request"
  qcIM (arbitrary :: Gen Request)
  putStrLn "Testing Offer"
  qcIM (arbitrary :: Gen Offer)
  putStrLn "Testing SlaveInfo"
  qcIM (arbitrary :: Gen SlaveInfo)