{-|
Module      : Gargantext.Core.Text.Corpus.Parsers.Date
Description : Some utils to parse dates
Copyright   : (c) CNRS 2017-present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

According to the language of the text, parseDateRaw returns date as Text:

TODO : Add some tests
import Gargantext.Core.Text.Corpus.Parsers.Date as DGP
DGP.parseDateRaw DGP.FR "12 avril 2010" == "2010-04-12T00:00:00.000+00:00"
-}

{-# OPTIONS_GHC -fno-warn-deprecations #-}

{-# LANGUAGE TypeFamilies #-}

module Gargantext.Core.Text.Corpus.Parsers.Date (
    dateSplit
  , mDateSplit
  , defaultDay
  , defaultUTCTime
  , split'
  ) where

import Data.List qualified as List
import Data.Text (unpack, splitOn, replace)
import Data.Time (defaultTimeLocale, iso8601DateFormat, parseTimeM, toGregorian)
import Data.Time.Calendar qualified as DTC
import Data.Time.Clock (UTCTime(..), secondsToDiffTime)
import Gargantext.Prelude hiding (replace)

------------------------------------------------------------------------
-- | Parse date to Ints
-- TODO add hours, minutes and seconds
dateSplit :: Text -> Either Text (UTCTime, (Year, Month, Day))
dateSplit txt = mkSplit <$> parse txt
  where
    mkSplit utcTime =
      let (y, m, d) = split' utcTime in
      (utcTime, (y, m, d))

mDateSplit :: Maybe Text -> (Maybe UTCTime, (Maybe Year, Maybe Month, Maybe Day))
mDateSplit Nothing = (Nothing, (Nothing, Nothing, Nothing))
mDateSplit (Just md) =
  case dateSplit md of
    Left _err -> (Nothing, (Nothing, Nothing, Nothing))
    Right (ut, (y, m, d)) -> (Just ut, (Just y, Just m, Just d))


split' :: UTCTime -> (Year, Month, Day)
split' (UTCTime day _) = (fromIntegral y, m, d)
  where
    (y,m,d)         = toGregorian day

type Year  = Int
type Month = Int
type Day   = Int
------------------------------------------------------------------------

-- | Date Parser
-- Parses dates mentions in full text given the language.
-- >>> parse FR (pack "1 avril 1900 à 19H")
-- 1900-04-01 19:00:00 UTC
-- >>> parse EN (pack "April 1 1900")
-- 1900-04-01 00:00:00 UTC
parse :: Text -> Either Text UTCTime
parse s = do
  -- printDebug "Date: " s
  let result = dateFlow (DucklingFailure s)
  --printDebug "Date': " dateStr'
  case result of
    DateFlowSuccess ok -> Right ok
    DateFlowFailure    -> Left "[G.C.T.C.Parsers.Date] DateFlowFailure"
    -- DateFlowFailure    -> (withDebugMode (DebugMode True)
    --                                     "[G.C.T.P.T.Date parse]" s
    --                                     $ getCurrentTime)
    _                   -> Left "[G.C.T.C.Parsers.Date] parse: Should not happen"

data DateFlow = DucklingSuccess { ds_result  :: Text }
              | DucklingFailure { df_result  :: Text }
              | ReadFailure1    { rf1_result :: Text }
              | ReadFailure2    { rf2_result :: Text }
              | DateFlowSuccess { success :: UTCTime }
              | DateFlowFailure
  deriving Show

--{-
dateFlow :: DateFlow -> DateFlow
dateFlow (DucklingSuccess res) = case (head $ splitOn "." res)  of
                             Nothing -> dateFlow (ReadFailure1 res)
                             Just re -> case readDate res of
                                Nothing -> dateFlow (ReadFailure1 re)
                                Just ok -> DateFlowSuccess ok
--dateFlow (DucklingFailure txt) = case readDate $ replace " " "T" txt of
dateFlow (DucklingFailure txt) = case readDate  (fromMaybe "" $ headMay $ List.filter (/= "") $ splitOn " " txt) of
                             Nothing -> dateFlow (ReadFailure1 txt)
                             Just ok -> DateFlowSuccess ok
dateFlow (ReadFailure1 txt) = case readDate txt of
                          Nothing -> dateFlow $ ReadFailure2 txt
                          Just ok -> DateFlowSuccess ok
dateFlow (ReadFailure2 txt) = case readDate $ replace " " "" txt <> "-01-01" of
                          Nothing -> DateFlowFailure
                          Just ok -> DateFlowSuccess ok
dateFlow _ = DateFlowFailure
--}

readDate :: Text -> Maybe UTCTime
readDate txt = do
  --let format = cs $ iso8601DateFormat (Just "%F %H:%M:%S")
  let format = cs $ iso8601DateFormat Nothing
  parseTimeM True defaultTimeLocale (unpack format) (cs txt)


defaultDay :: DTC.Day
defaultDay = DTC.fromGregorian 1 1 1

defaultUTCTime :: UTCTime
defaultUTCTime = UTCTime { utctDay = defaultDay
                         , utctDayTime = secondsToDiffTime 0 }
