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  : alexandre.delanoe@iscpif.fr
   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
  18 module Data.Gargantext.Parsers.Date (parseDate1, Lang(FR, EN)) where
  19
  20 import Data.Gargantext.Prelude
  21 import qualified Data.Gargantext.Types.Main as G
  22
  23 import Data.Time.Clock (UTCTime, getCurrentTime)
  24 import Data.Time.LocalTime.TimeZone.Series (zonedTimeToZoneSeriesTime)
  25 import Data.Time.LocalTime (utc)
  26 import Duckling.Resolve (fromUTC, Context(Context, referenceTime, locale)
  27                         , DucklingTime(DucklingTime)
  28                         )
  29 import Duckling.Core (makeLocale, Lang(FR,EN), Some(This), Dimension(Time))
  30 import Duckling.Types (jsonValue)
  31 --import qualified Duckling.Core as DC
  32
  33 import Duckling.Api (analyze)
  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 Safe (headMay)
  44
  45 import Duckling.Types (ResolvedToken)
  46
  47
  48
  49 -- TODO add Paris at Duckling.Locale Region datatype
  50 -- | To get Homogeinity of the languages
  51 --   TODO : put this in a more generic place in the source code
  52 parserLang :: G.Language -> Lang
  53 parserLang G.FR = FR
  54 parserLang G.EN = EN
  55
  56
  57
  58 -- | Final Date parser API
  59 parseDate1 :: Lang -> Text -> IO Text
  60 parseDate1 lang text = do
  61     maybeJson <- pm jsonValue <$> parseDateWithDuckling lang text
  62     case headMay maybeJson of
  63       Just (Json.Object object) -> case HM.lookup "value" object of
  64                                      Just (Json.String date) -> pure date
  65                                      Just _             -> error "ERROR: should be a json String"
  66                                      Nothing            -> error "No date found"
  67       Just _                    -> error "ERROR: should be a json Object"
  68       Nothing                   -> pure "No date found"
  69
  70
  71
  72 -- | Current Time in DucklingTime format
  73 -- TODO : get local Time in a more generic way
  74 utcToDucklingTime :: UTCTime -> DucklingTime
  75 utcToDucklingTime time = DucklingTime . zonedTimeToZoneSeriesTime $ fromUTC time utc
  76
  77 -- | Local Context which depends on Lang and Time
  78 localContext :: Lang -> DucklingTime -> Context
  79 localContext lang dt = Context {referenceTime = dt, locale = makeLocale lang Nothing}
  80
  81 -- | Date parser with Duckling
  82 parseDateWithDuckling :: Lang -> Text -> IO [ResolvedToken]
  83 parseDateWithDuckling lang input = do
  84     ctx <- localContext lang <$> utcToDucklingTime <$> getCurrentTime
  85     --pure $ parseAndResolve (rulesFor (locale ctx) (HashSet.fromList [(This Time)])) input ctx
  86     pure $ analyze input ctx $ HashSet.fromList [(This Time)]
  87