]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Text/Corpus/Parsers/Date/Parsec.hs
Merge branch 'dev' into dev-phylo
[gargantext.git] / src / Gargantext / Text / Corpus / Parsers / Date / Parsec.hs
1 {-|
2 Module : Gargantext.Text.Corpus.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.Corpus.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