src/Gargantext/Text/Parsers/Date/Parsec.hs

   1 {-|
   2 Module      : Gargantext.Text.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 -}
  11
  12 {-# LANGUAGE FlexibleContexts  #-}
  13 {-# LANGUAGE NoImplicitPrelude #-}
  14 {-# LANGUAGE OverloadedStrings #-}
  15
  16 module Gargantext.Text.Parsers.Date.Parsec
  17   where
  18
  19 import Control.Monad ((=<<))
  20 import Data.Either (Either)
  21 import Data.Fixed (Fixed (MkFixed))
  22 import Data.Foldable (length)
  23 import Data.String (String)
  24 import Data.Text (Text, unpack)
  25 import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), TimeOfDay(..))
  26 import Data.Time.Calendar (Day, fromGregorian)
  27 import Gargantext.Prelude
  28 import Prelude (toInteger, div, otherwise, (++))
  29 import Text.Parsec.Error (ParseError)
  30 import Text.Parsec.Prim (Stream, ParsecT)
  31 import Text.Parsec.String (Parser)
  32 import Text.ParserCombinators.Parsec (many1, noneOf, anyChar, char, oneOf)
  33 import Text.XML.HXT.DOM.Util (decimalStringToInt)
  34 import qualified Text.ParserCombinators.Parsec (parse)
  35
  36 -- | Permit to transform a String to an Int in a monadic context
  37 wrapDST :: Monad m => String -> m Int
  38 wrapDST = return . decimalStringToInt
  39
  40 -- | Generic parser which take at least one element not given in argument
  41 many1NoneOf :: Stream s m Char => [Char] -> ParsecT s u m [Char]
  42 many1NoneOf = (many1 . noneOf)
  43
  44 getMultiplicator :: Int -> Int
  45 getMultiplicator a
  46   | 0 >= a = 1
  47   | otherwise = 10 * (getMultiplicator $ div a 10)
  48
  49 -- | Parser for date format y-m-d
  50 parseGregorian :: Parser Day
  51 parseGregorian  = do
  52         y <- wrapDST =<< many1NoneOf ['-']
  53         _ <- char '-'
  54         m <- wrapDST =<< many1NoneOf ['-']
  55         _ <- char '-'
  56         d <- wrapDST =<< many1NoneOf ['T']
  57         _ <- char 'T'
  58         return $ fromGregorian (toInteger y) m d
  59
  60 ---- | Parser for time format h:m:s
  61 parseTimeOfDay :: Parser TimeOfDay
  62 parseTimeOfDay = do
  63         h <- wrapDST =<< many1NoneOf [':']
  64         _ <- char ':'
  65         m <- wrapDST =<< many1NoneOf [':']
  66         _ <- char ':'
  67         r <- many1NoneOf ['.']
  68         _ <- char '.'
  69         dec <- many1NoneOf ['+', '-']
  70         let (nb, l) = (decimalStringToInt $ r ++ dec, length dec)
  71             seconds = nb * 10^(12-l)
  72         return $ TimeOfDay h m (MkFixed . toInteger $ seconds)
  73
  74
  75 -- | Parser for timezone format +hh:mm
  76 parseTimeZone :: Parser TimeZone
  77 parseTimeZone = do
  78         sign <- oneOf ['+', '-']
  79         h <- wrapDST =<< many1NoneOf [':']
  80         _ <- char ':'
  81         m <- wrapDST =<< (many1 $ anyChar)
  82         let timeInMinute = if sign == '+' then h * 60 + m else -h * 60 - m
  83          in return $ TimeZone timeInMinute False "CET"
  84
  85 ---- | Parser which use parseGregorian, parseTimeOfDay and parseTimeZone to create a ZonedTime
  86 parseZonedTime :: Parser ZonedTime
  87 parseZonedTime= do
  88         d <- parseGregorian
  89         tod <- parseTimeOfDay
  90         tz <- parseTimeZone
  91         return $ ZonedTime (LocalTime d (tod)) tz
  92
  93 ---- | Opposite of toRFC3339
  94 fromRFC3339 :: Text -> Either ParseError ZonedTime
  95 fromRFC3339 t = Text.ParserCombinators.Parsec.parse parseZonedTime "ERROR: Couldn't parse zoned time." input
  96         where input = unpack t