src-test/Parsers/Types.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans #-}
   2 {-# LANGUAGE NoImplicitPrelude    #-}
   3 {-# LANGUAGE StandaloneDeriving   #-}
   4
   5 module Parsers.Types where
   6
   7 import Gargantext.Prelude
   8
   9 import Test.QuickCheck
  10 import Test.QuickCheck.Instances ()
  11
  12 import Text.Parsec.Pos
  13 import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
  14 import Data.Time.LocalTime (ZonedTime (..), TimeZone (..), TimeOfDay(..), LocalTime(..))
  15 import Data.Eq (Eq(..))
  16 import Data.Either (Either(..))
  17
  18 deriving instance Eq ZonedTime
  19
  20 looseTimeOfDayPrecision :: TimeOfDay -> TimeOfDay
  21 looseTimeOfDayPrecision (TimeOfDay h m _) = TimeOfDay h m 0
  22
  23 looseLocalTimePrecision :: LocalTime -> LocalTime
  24 looseLocalTimePrecision (LocalTime ld ltd) = LocalTime ld $ looseTimeOfDayPrecision ltd
  25
  26 looseTimeZonePrecision :: TimeZone -> TimeZone
  27 looseTimeZonePrecision (TimeZone zm _ _) = TimeZone zm False "CET"
  28
  29 looseZonedTimePrecision :: ZonedTime -> ZonedTime
  30 looseZonedTimePrecision (ZonedTime lt tz) = ZonedTime (looseLocalTimePrecision lt) $ looseTimeZonePrecision tz
  31
  32 loosePrecisionEitherPEZT :: Either ParseError ZonedTime -> Either ParseError ZonedTime
  33 loosePrecisionEitherPEZT (Right zt) = Right $ looseZonedTimePrecision zt
  34 loosePrecisionEitherPEZT pe = pe
  35
  36 instance Arbitrary Message where
  37   arbitrary = do
  38     msgContent <- arbitrary
  39     oneof $ return <$> [SysUnExpect msgContent
  40                        , UnExpect msgContent
  41                        , Expect msgContent
  42                        , Message msgContent
  43                        ]
  44
  45 instance Arbitrary SourcePos where
  46   arbitrary = do
  47     sn <- arbitrary
  48     l <- arbitrary
  49     c <- arbitrary
  50     return $ newPos sn l c
  51
  52 instance Arbitrary ParseError where
  53   arbitrary = do
  54     sp <- arbitrary
  55     msg <- arbitrary
  56     return $ newErrorMessage msg sp