src/Data/Gargantext/Parsers/Date.hs

   1 {-|
   2 Module      : Data.Gargantext.Parsers.Date
   3 Description : Some utils to parse dates
   4 Copyright   : (c) CNRS 2017-present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 According to the language of the text, parseDate1 returns date as Text:
  11
  12 TODO : Add some tests
  13 import Data.Gargantext.Parsers.Date as DGP
  14 DGP.parseDate1 DGP.FR "12 avril 2010" == "2010-04-12T00:00:00.000+00:00"
  15 -}
  16
  17 {-# LANGUAGE OverloadedStrings #-}
  18
  19 module Data.Gargantext.Parsers.Date (parseDate1, Lang(FR, EN), parseDate) where
  20
  21 import Data.Gargantext.Prelude
  22 --import Data.Gargantext.Types.Main as G
  23
  24 import Data.Time.Clock (UTCTime, getCurrentTime)
  25 import Data.Time.LocalTime.TimeZone.Series (zonedTimeToZoneSeriesTime)
  26 import Data.Time.LocalTime (utc)
  27 import Duckling.Resolve (fromUTC, Context(Context, referenceTime, locale)
  28                         , DucklingTime(DucklingTime)
  29                         )
  30 import Duckling.Core (makeLocale, Lang(FR,EN), Some(This), Dimension(Time))
  31 import Duckling.Types (jsonValue, Entity)
  32
  33 import Duckling.Api (analyze, parse)
  34 import qualified Data.HashSet as HashSet
  35 import qualified Data.Aeson   as Json
  36 import Data.HashMap.Strict as HM
  37
  38 import Data.Text (Text)
  39 -- import Duckling.Engine (parseAndResolve)
  40 -- import Duckling.Rules (rulesFor)
  41 -- import Duckling.Debug as DB
  42
  43 import Duckling.Types (ResolvedToken)
  44 import Safe (headMay)
  45
  46
  47 -- TODO add Paris at Duckling.Locale Region datatype
  48 -- | To get Homogeinity of the languages
  49 --   TODO : put this in a more generic place in the source code
  50 --parserLang :: G.Language -> Lang
  51 --parserLang G.FR = FR
  52 --parserLang G.EN = EN
  53
  54
  55 -- | Final Date parser API
  56 parseDate1 :: Lang -> Text -> IO Text
  57 parseDate1 lang text = do
  58     maybeJson <- pm jsonValue <$> parseDateWithDuckling lang text
  59     case headMay maybeJson of
  60       Just (Json.Object object) -> case HM.lookup "value" object of
  61                                      Just (Json.String date) -> pure date
  62                                      Just _                  -> error "ParseDate ERROR: should be a json String"
  63                                      Nothing                 -> error "ParseDate ERROR: no date found"
  64       _                         -> error "ParseDate ERROR: type error"
  65
  66
  67
  68 -- | Current Time in DucklingTime format
  69 -- TODO : get local Time in a more generic way
  70 utcToDucklingTime :: UTCTime -> DucklingTime
  71 utcToDucklingTime time = DucklingTime . zonedTimeToZoneSeriesTime $ fromUTC time utc
  72
  73 -- | Local Context which depends on Lang and Time
  74 localContext :: Lang -> DucklingTime -> Context
  75 localContext lang dt = Context {referenceTime = dt, locale = makeLocale lang Nothing}
  76
  77 -- | Date parser with Duckling
  78 parseDateWithDuckling :: Lang -> Text -> IO [ResolvedToken]
  79 parseDateWithDuckling lang input = do
  80     contxt <- localContext lang <$> utcToDucklingTime <$> getCurrentTime
  81     --pure $ parseAndResolve (rulesFor (locale ctx) (HashSet.fromList [(This Time)])) input ctx
  82     pure $ analyze input contxt $ HashSet.fromList [(This Time)]
  83
  84
  85 parseDate :: Lang -> Text -> IO [Entity]
  86 parseDate lang input = do
  87     context <- localContext lang <$> utcToDucklingTime <$> getCurrentTime
  88     pure $ parse input context [(This Time)]
  89
  90
  91
  92
  93