]> Git — Sourcephile - gargantext.git/blob - src-test/Parsers/Types.hs
changement du seuil
[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 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