add lose precision

gargantext.cabal

@@ -40,6 +40,7 @@ library
     , extra
     , filepath
     , http-conduit
+    , hxt
     , ini
     , lens
     , logging-effect
@@ -162,16 +163,22 @@ test-suite garg-test
   build-depends:
       QuickCheck
     , base
+    , duckling
     , extra
     , gargantext
     , hspec
+    , parsec
+    , quickcheck-instances
     , text
+    , time
   other-modules:
       Ngrams.Lang
       Ngrams.Lang.En
       Ngrams.Lang.Fr
       Ngrams.Lang.Occurrences
       Ngrams.Metrics
+      Parsers.Date
+      Parsers.Types
       Parsers.WOS
       Paths_gargantext
   default-language: Haskell2010

src-test/Parsers/Date.hs

@@ -8,6 +8,8 @@ import Test.Hspec
 import Test.QuickCheck
 import Parsers.Types
 
+import Control.Applicative ((<*>))
+import Data.Tuple (uncurry)
 import Data.Either (Either(..))
 import Data.Time (ZonedTime(..))
 import Data.Text (pack, Text)
@@ -18,11 +20,15 @@ import Gargantext.Parsers.Date (fromRFC3339)
 
 fromRFC3339Inv ::  Either ParseError ZonedTime -> Text
 fromRFC3339Inv (Right z) = toRFC3339 z
-fromRFC3339Inv (Left pe) = pack $ show pe
+fromRFC3339Inv (Left pe) = panic . pack $ show pe
 
-{-testFromRFC3339 :: IO ()
+testFromRFC3339 :: IO ()
 testFromRFC3339 = hspec $ do
   describe "Test fromRFC3339: " $ do
     it "is the inverse of Duckling's toRFC3339" $ property $
-      \x -> (fromRFC3339 . fromRFC3339Inv) x == (x :: Either ParseError ZonedTime)
---}
+      ((==) <*> (fromRFC3339 . fromRFC3339Inv)) . Right . looseZonedTimePrecision
+
+      -- \x -> uncurry (==) $ (,) <*> (fromRFC3339 . fromRFC3339Inv) $ Right $ looseZonedTimePrecision x
+
+      -- \x -> let e = Right x :: Either ParseError ZonedTime
+      --       in fmap looseZonedTimePrecision e == (fromRFC3339 . fromRFC3339Inv ) (fmap looseZonedTimePrecision e)

src-test/Parsers/Types.hs

@@ -4,16 +4,35 @@
 module Parsers.Types where
 
 import Gargantext.Prelude
+import Prelude (floor, fromIntegral)
 
 import Test.QuickCheck
-import Test.QuickCheck.Instances()
+import Test.QuickCheck.Instances ()
 
 import Text.Parsec.Pos
 import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
-import Data.Time.LocalTime (ZonedTime (..))
+import Data.Time.LocalTime (ZonedTime (..), TimeZone (..), TimeOfDay(..), LocalTime(..))
 import Data.Eq (Eq(..))
+import Data.Either (Either(..))
+
 deriving instance Eq ZonedTime
 
+looseTimeOfDayPrecision :: TimeOfDay -> TimeOfDay
+looseTimeOfDayPrecision (TimeOfDay h m s) = TimeOfDay h m 0
+
+looseLocalTimePrecision :: LocalTime -> LocalTime
+looseLocalTimePrecision (LocalTime ld ltd) = LocalTime ld $ looseTimeOfDayPrecision ltd
+
+looseTimeZonePrecision :: TimeZone -> TimeZone
+looseTimeZonePrecision (TimeZone zm _ _) = TimeZone zm False "CET"
+
+looseZonedTimePrecision :: ZonedTime -> ZonedTime
+looseZonedTimePrecision (ZonedTime lt tz) = ZonedTime (looseLocalTimePrecision lt) $ looseTimeZonePrecision tz
+
+loosePrecisionEitherPEZT :: Either ParseError ZonedTime -> Either ParseError ZonedTime
+loosePrecisionEitherPEZT (Right zt) = Right $ looseZonedTimePrecision zt
+loosePrecisionEitherPEZT pe = pe
+
 instance Arbitrary Message where
   arbitrary = do
     msgContent <- arbitrary

src/Gargantext/Parsers/Date.hs

@@ -36,7 +36,7 @@ import Duckling.Types (jsonValue, Entity)
 import Duckling.Api (analyze, parse)
 import qualified Data.HashSet as HashSet
 import qualified Data.Aeson   as Json
-import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), TimeOfDay(..), getCurrentTimeZone)
+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), TimeOfDay(..))
 import Data.Time.Calendar (Day, fromGregorian)
 import Data.Fixed (Fixed (MkFixed))
 import Data.Foldable (length)
@@ -52,7 +52,6 @@ import Data.Text (Text, unpack)
 
 import Duckling.Types (ResolvedToken)
 import Safe (headMay)
-import System.IO.Unsafe (unsafePerformIO)
 
 import Text.Parsec.Error (ParseError)
 import Text.Parsec.String (Parser)
@@ -144,7 +143,7 @@ parseTimeOfDay = do
         _ <- char '.'
         dec <- many1NoneOf ['+', '-']
         let (nb, l) = (decimalStringToInt $ r ++ dec, length dec)
-            seconds = nb * 10^(12-l) 
+            seconds = nb * 10^(12-l)
         return $ TimeOfDay h m (MkFixed . toInteger $ seconds)
 
 
@@ -155,9 +154,8 @@ parseTimeZone = do
         h <- wrapDST =<< many1NoneOf [':']
         _ <- char ':'
         m <- wrapDST =<< (many1 $ anyChar)
-        let (TimeZone _ s n) = unsafePerformIO getCurrentTimeZone
         let timeInMinute = if sign == '+' then h * 60 + m else -h * 60 - m
-         in return $ TimeZone timeInMinute s n
+         in return $ TimeZone timeInMinute False "CET"
 
 -- | Parser which use parseGregorian, parseTimeOfDay and parseTimeZone to create a ZonedTime
 parseZonedTime :: Parser ZonedTime