src/Gargantext/Parsers/Date.hs

   1 {-|
   2 Module      : 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 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 {-# LANGUAGE NoImplicitPrelude #-}
  19
  20 module Gargantext.Parsers.Date (parseDate1, Lang(FR, EN), parseDate) where
  21
  22 import Gargantext.Prelude
  23 --import Gargantext.Types.Main as G
  24
  25 import Data.Time.Clock (UTCTime, getCurrentTime)
  26 import Data.Time.LocalTime.TimeZone.Series (zonedTimeToZoneSeriesTime)
  27 import Data.Time.LocalTime (utc)
  28 import Duckling.Resolve (fromUTC, Context(Context, referenceTime, locale)
  29                         , DucklingTime(DucklingTime)
  30                         )
  31 import Duckling.Core (makeLocale, Lang(FR,EN), Some(This), Dimension(Time))
  32 import Duckling.Types (jsonValue, Entity)
  33
  34 import Duckling.Api (analyze, parse)
  35 import qualified Data.HashSet as HashSet
  36 import qualified Data.Aeson   as Json
  37 import Data.HashMap.Strict as HM hiding (map)
  38
  39 import Data.Text (Text)
  40 -- import Duckling.Engine (parseAndResolve)
  41 -- import Duckling.Rules (rulesFor)
  42 -- import Duckling.Debug as DB
  43
  44 import Duckling.Types (ResolvedToken)
  45 import Safe (headMay)
  46
  47
  48 -- TODO add Paris at Duckling.Locale Region datatype
  49 -- | To get Homogeinity of the languages
  50 --   TODO : put this in a more generic place in the source code
  51 --parserLang :: G.Language -> Lang
  52 --parserLang G.FR = FR
  53 --parserLang G.EN = EN
  54
  55
  56 -- | Final Date parser API
  57 -- IO can be avoided here:
  58 -- currentContext :: Lang -> IO Context
  59 -- currentContext lang = localContext lang <$> utcToDucklingTime <$> getCurrentTime
  60 -- parseDate1 :: Context -> Text -> SomeErrorHandling Text
  61 parseDate1 :: Lang -> Text -> IO Text
  62 parseDate1 lang text = do
  63     maybeJson <- map jsonValue <$> parseDateWithDuckling lang text
  64     case headMay maybeJson of
  65       Just (Json.Object object) -> case HM.lookup "value" object of
  66                                      Just (Json.String date) -> pure date
  67                                      Just _                  -> panic "ParseDate ERROR: should be a json String"
  68                                      Nothing                 -> panic "ParseDate ERROR: no date found"
  69       _                         -> panic "ParseDate ERROR: type error"
  70
  71
  72
  73 -- | Current Time in DucklingTime format
  74 -- TODO : get local Time in a more generic way
  75 utcToDucklingTime :: UTCTime -> DucklingTime
  76 utcToDucklingTime time = DucklingTime . zonedTimeToZoneSeriesTime $ fromUTC time utc
  77
  78 -- | Local Context which depends on Lang and Time
  79 localContext :: Lang -> DucklingTime -> Context
  80 localContext lang dt = Context {referenceTime = dt, locale = makeLocale lang Nothing}
  81
  82 -- | Date parser with Duckling
  83 parseDateWithDuckling :: Lang -> Text -> IO [ResolvedToken]
  84 parseDateWithDuckling lang input = do
  85     contxt <- localContext lang <$> utcToDucklingTime <$> getCurrentTime
  86     --pure $ parseAndResolve (rulesFor (locale ctx) (HashSet.fromList [(This Time)])) input ctx
  87     pure $ analyze input contxt $ HashSet.fromList [(This Time)]
  88
  89
  90 parseDate :: Lang -> Text -> IO [Entity]
  91 parseDate lang input = do
  92     context <- localContext lang <$> utcToDucklingTime <$> getCurrentTime
  93     pure $ parse input context [(This Time)]
  94
  95
  96
  97
  98