src-test/Parsers/Types.hs

   1 {-|
   2 Module      : Parsers.Types
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Here is a longer description of this module, containing some
  11 commentary with @some markup@.
  12 -}
  13
  14 {-# OPTIONS_GHC -fno-warn-orphans #-}
  15
  16 {-# LANGUAGE NoImplicitPrelude    #-}
  17 {-# LANGUAGE StandaloneDeriving   #-}
  18
  19 module Parsers.Types where
  20
  21 import Gargantext.Prelude
  22
  23 import Test.QuickCheck
  24 import Test.QuickCheck.Instances ()
  25
  26 import Text.Parsec.Pos
  27 import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
  28 import Data.Time.LocalTime (ZonedTime (..), TimeZone (..), TimeOfDay(..), LocalTime(..))
  29 import Data.Eq (Eq(..))
  30 import Data.Either (Either(..))
  31
  32 deriving instance Eq ZonedTime
  33
  34 looseTimeOfDayPrecision :: TimeOfDay -> TimeOfDay
  35 looseTimeOfDayPrecision (TimeOfDay h m _) = TimeOfDay h m 0
  36
  37 looseLocalTimePrecision :: LocalTime -> LocalTime
  38 looseLocalTimePrecision (LocalTime ld ltd) = LocalTime ld $ looseTimeOfDayPrecision ltd
  39
  40 looseTimeZonePrecision :: TimeZone -> TimeZone
  41 looseTimeZonePrecision (TimeZone zm _ _) = TimeZone zm False "CET"
  42
  43 looseZonedTimePrecision :: ZonedTime -> ZonedTime
  44 looseZonedTimePrecision (ZonedTime lt tz) = ZonedTime (looseLocalTimePrecision lt) $ looseTimeZonePrecision tz
  45
  46 loosePrecisionEitherPEZT :: Either ParseError ZonedTime -> Either ParseError ZonedTime
  47 loosePrecisionEitherPEZT (Right zt) = Right $ looseZonedTimePrecision zt
  48 loosePrecisionEitherPEZT pe = pe
  49
  50 instance Arbitrary Message where
  51   arbitrary = do
  52     msgContent <- arbitrary
  53     oneof $ return <$> [SysUnExpect msgContent
  54                        , UnExpect msgContent
  55                        , Expect msgContent
  56                        , Message msgContent
  57                        ]
  58
  59 instance Arbitrary SourcePos where
  60   arbitrary = do
  61     sn <- arbitrary
  62     l <- arbitrary
  63     c <- arbitrary
  64     return $ newPos sn l c
  65
  66 instance Arbitrary ParseError where
  67   arbitrary = do
  68     sp <- arbitrary
  69     msg <- arbitrary
  70     return $ newErrorMessage msg sp