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
   5 License     : AGPL + CECILL v3
   6 Maintainer  : dev@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 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)) 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)
  32 --import qualified Duckling.Core as DC
  33
  34 import Duckling.Api (analyze)
  35 import qualified Data.HashSet as HashSet
  36 import qualified Data.Aeson   as Json
  37 import Data.HashMap.Strict as HM
  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 parseDate1 :: Lang -> Text -> IO Text
  58 parseDate1 lang text = do
  59     maybeJson <- pm jsonValue <$> parseDateWithDuckling lang text
  60     case headMay maybeJson of
  61       Just (Json.Object object) -> case HM.lookup "value" object of
  62                                      Just (Json.String date) -> pure date
  63                                      Just _             -> error "ERROR: should be a json String"
  64                                      Nothing            -> error "No date found"
  65       Just _                    -> error "ERROR: should be a json Object"
  66       Nothing                   -> pure "No date found"
  67
  68
  69
  70 -- | Current Time in DucklingTime format
  71 -- TODO : get local Time in a more generic way
  72 utcToDucklingTime :: UTCTime -> DucklingTime
  73 utcToDucklingTime time = DucklingTime . zonedTimeToZoneSeriesTime $ fromUTC time utc
  74
  75 -- | Local Context which depends on Lang and Time
  76 localContext :: Lang -> DucklingTime -> Context
  77 localContext lang dt = Context {referenceTime = dt, locale = makeLocale lang Nothing}
  78
  79 -- | Date parser with Duckling
  80 parseDateWithDuckling :: Lang -> Text -> IO [ResolvedToken]
  81 parseDateWithDuckling lang input = do
  82     ctx <- localContext lang <$> utcToDucklingTime <$> getCurrentTime
  83     --pure $ parseAndResolve (rulesFor (locale ctx) (HashSet.fromList [(This Time)])) input ctx
  84     pure $ analyze input ctx $ HashSet.fromList [(This Time)]
  85