]> Git — Sourcephile - gargantext.git/blob - src-test/Parsers/Types.hs
[FIX] merge
[gargantext.git] / 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 StandaloneDeriving #-}
17
18 module Parsers.Types where
19
20 import Gargantext.Prelude
21
22 import Test.QuickCheck
23 import Test.QuickCheck.Instances ()
24
25 import Text.Parsec.Pos
26 import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
27 import Data.Time.LocalTime (ZonedTime (..), TimeZone (..), TimeOfDay(..), LocalTime(..))
28 import Data.Eq (Eq(..))
29 import Data.Either (Either(..))
30
31 deriving instance Eq ZonedTime
32
33 looseTimeOfDayPrecision :: TimeOfDay -> TimeOfDay
34 looseTimeOfDayPrecision (TimeOfDay h m _) = TimeOfDay h m 0
35
36 looseLocalTimePrecision :: LocalTime -> LocalTime
37 looseLocalTimePrecision (LocalTime ld ltd) = LocalTime ld $ looseTimeOfDayPrecision ltd
38
39 looseTimeZonePrecision :: TimeZone -> TimeZone
40 looseTimeZonePrecision (TimeZone zm _ _) = TimeZone zm False "CET"
41
42 looseZonedTimePrecision :: ZonedTime -> ZonedTime
43 looseZonedTimePrecision (ZonedTime lt tz) = ZonedTime (looseLocalTimePrecision lt) $ looseTimeZonePrecision tz
44
45 loosePrecisionEitherPEZT :: Either ParseError ZonedTime -> Either ParseError ZonedTime
46 loosePrecisionEitherPEZT (Right zt) = Right $ looseZonedTimePrecision zt
47 loosePrecisionEitherPEZT pe = pe
48
49 instance Arbitrary Message where
50 arbitrary = do
51 msgContent <- arbitrary
52 oneof $ return <$> [SysUnExpect msgContent
53 , UnExpect msgContent
54 , Expect msgContent
55 , Message msgContent
56 ]
57
58 instance Arbitrary SourcePos where
59 arbitrary = do
60 sn <- arbitrary
61 l <- arbitrary
62 c <- arbitrary
63 return $ newPos sn l c
64
65 instance Arbitrary ParseError where
66 arbitrary = do
67 sp <- arbitrary
68 msg <- arbitrary
69 return $ newErrorMessage msg sp