diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,6 +3,7 @@ [![Build Status](https://travis-ci.org/ReedOei/fuzzy-dates.svg?branch=master)](https://travis-ci.org/ReedOei/fuzzy-dates) `fuzzy-dates` is a Haskell library for parsing dates when you don't know/care to specify the format of the dates beforehand. +It returns dates and times in the [hourglass](https://hackage.haskell.org/package/hourglass) format. It is heavily based off of , which had not been updated for over 2 years at the time of writing, so I created this library, and added numerous new date formats to it. @@ -15,4 +16,9 @@ >>> extractDatesY 2018 "The party will be on 6/9" [Date 2018 June 9] ``` + +``` +>>> import Data.Dates.Parsing +>>> extractDateTimes "This morning, 06.07.16 at 7:35 AM, the fire was stopped." :: IO [DateTime] +[DateTime {dtDate = Date {dateYear = 2016, dateMonth = July, dateDay = 6}, dtTime = TimeOfDay {todHour = 7h, todMin = 35m, todSec = 0s, todNSec = 0ns}}] diff --git a/fuzzy-dates.cabal b/fuzzy-dates.cabal --- a/fuzzy-dates.cabal +++ b/fuzzy-dates.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: ed41d65cf10fed9a19edd4cf11647d5b5b0bc61c2e88ad8787cb63bfdab65117 +-- hash: 6a8d6e225575470d48cebf6d738a62eb7ebf163682b16ff24c4e75df6dc4955f name: fuzzy-dates -version: 0.1.0.2 +version: 0.1.1.0 synopsis: Libary for parsing dates in strings in varied formats. description: Please see the README on GitHub at category: Parsing diff --git a/src/Data/Dates/Parsing.hs b/src/Data/Dates/Parsing.hs --- a/src/Data/Dates/Parsing.hs +++ b/src/Data/Dates/Parsing.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} -- | Parse strings that aren't so precise module Data.Dates.Parsing @@ -17,7 +18,7 @@ , pAbsDate , pDate , pDateTime - , pTime + , time , pDateInterval , weekdayToInterval , dateWeekDay @@ -29,7 +30,9 @@ , negateInterval , minusInterval , dateInFormat - , extractDates, extractDatesY, extract + , extractDates, extractDatesY + , extractDateTimes, extractDateTimesY + , extract ) where import Control.Lens @@ -39,6 +42,7 @@ import Data.Data (Data, Typeable) import Data.Hourglass import Data.List (intercalate, find) +import Data.Maybe (catMaybes) import Text.Parsec import Text.Read (readMaybe) @@ -86,24 +90,33 @@ lookupMonth :: String -> Either [Month] Month lookupMonth = uniqFuzzyMatch -time :: Stream s m Char => Hours -> ParsecT s st m TimeOfDay -time hMax = do - h <- number 2 hMax - char ':' - m <- number 2 59 - x <- optionMaybe $ char ':' - case x of - Nothing -> return $ TimeOfDay h m 0 0 - Just _ -> do - s <- number 2 59 - notFollowedBy letter - return $ TimeOfDay h m s 0 +time :: Stream s m Char => ParsecT s st m TimeOfDay +time = do + h <- fromIntegral <$> number 2 23 + minSep <- optionMaybe $ char ':' <|> char '.' + (m, mOffset) <- + case minSep of + Nothing -> (0,) <$> (optional spaces >> optionMaybe ampm) + Just _ -> do + m <- number 2 59 + (m,) <$> (optional spaces >> optionMaybe ampm) -time24 :: Stream s m Char => ParsecT s st m TimeOfDay -time24 = time 23 -time12 :: Stream s m Char => ParsecT s st m TimeOfDay -time12 = time 12 + sep <- optionMaybe $ char ':' <|> char '.' + (s, offset) <- + case sep of + Nothing -> (0,) <$> (optional spaces >> optionMaybe ampm) + Just _ -> do + s <- number 2 59 + (s,) <$> (optional spaces >> optionMaybe ampm) + if h > 12 then -- It shouldn't be a 24 hour time, so just ignore offset, if any + pure $ TimeOfDay (Hours h) (Minutes m) (Seconds s) 0 + else + case (mOffset, offset) of + (Just mo, _) -> pure $ TimeOfDay (Hours (h + fromIntegral mo)) (Minutes m) (Seconds s) 0 + (Nothing, Just o) -> pure $ TimeOfDay (Hours (h + fromIntegral o)) (Minutes m) (Seconds s) 0 + (Nothing, Nothing)-> pure $ TimeOfDay (Hours h) (Minutes m) (Seconds s) 0 + ampm :: Stream s m Char => ParsecT s st m Int ampm = do s <- many1 letter @@ -112,10 +125,6 @@ "PM" -> return 12 _ -> fail "AM/PM expected" - -pTime :: Stream s m Char => ParsecT s st m TimeOfDay -pTime = choice $ map try [time12, time24] - newtype DateFormat = DateFormat [(DatePart, String)] data DatePart = D | M | Y data DatePartVal = DV Int | MV Month | YV Int @@ -173,15 +182,18 @@ pAbsDateTime :: Stream s m Char => Int -> ParsecT s st m DateTime pAbsDateTime year = do - date <- pAbsDate year - optional $ char ',' - s <- optionMaybe space - case s of - Nothing -> return $ DateTime date (TimeOfDay 0 0 0 0) - Just _ -> do - t <- pTime - return $ DateTime date t + date <- pAbsDate year + optional spaces + optional $ string "at" + optional spaces + + maybeT <- optionMaybe time + + case maybeT of + Nothing -> pure $ DateTime date (TimeOfDay 0 0 0 0) + Just t -> pure $ DateTime date t + pAbsDate :: Stream s m Char => Int -> ParsecT s st m Date pAbsDate year = choice $ map (try . dateInFormat year) [euroNumDate, americanDate, strDate, writtenDate, dashDate, @@ -390,8 +402,31 @@ Left err -> error $ show err Right dates -> dates +extractDateTimes :: String -> IO [DateTime] +extractDateTimes str = do + c <- defaultConfigIO + + pure $ extractDateTimesY (dateYear (timeGetDate (c ^. now))) str + +-- | Extract dates with optional times from a string, with the first argument being the current year (used for things like "Jan 18"). +-- If no time is specified, will return time at midnight. +-- +-- >>> extractDateTimesY 2018 "The talk starts at 12.09.12 8:00 AM" +-- [DateTime {dtDate = Date {dateYear = 2012, dateMonth = September, dateDay = 12}, dtTime = TimeOfDay {todHour = 8h, todMin = 0m, todSec = 0s, todNSec = 0ns}}] +-- +-- >>> extractDateTimesY 2018 "The party will be on 6/9" +-- [DateTime {dtDate = Date {dateYear = 2018, dateMonth = June, dateDay = 9}, dtTime = TimeOfDay {todHour = 0h, todMin = 0m, todSec = 0s, todNSec = 0ns}}] +extractDateTimesY :: Int -> String -> [DateTime] +extractDateTimesY y str = + case parse (extract (pAbsDateTime y)) "" str of + Left err -> error $ show err + Right dates -> dates + extract :: Stream s m Char => ParsecT s st m a -> ParsecT s st m [a] -extract parser = Text.Parsec.many loop +extract parser = catMaybes <$> Text.Parsec.manyTill (try (Just <$> loop) <|> (anyChar >> pure Nothing)) eof where - loop = try parser <|> (anyChar >> loop) + loop = try parser <|> do + anyChar + notFollowedBy eof + loop diff --git a/src/Data/Dates/Parsing/Internal.hs b/src/Data/Dates/Parsing/Internal.hs --- a/src/Data/Dates/Parsing/Internal.hs +++ b/src/Data/Dates/Parsing/Internal.hs @@ -19,15 +19,15 @@ pure $ v : rest -- | Parse natural number of N digits which is not greater than M -number :: (Stream s m Char, Read a, Num a, Ord a) +number :: (Stream s m Char, Integral a, Show a) => Int -- ^ Number of digits -> a -- ^ Maximum value -> ParsecT s st m a number n m = do maybeT <- readMaybe <$> takeN1 n digit - case maybeT of + case fromIntegral <$> maybeT of Just t | t <= m -> pure t - _ -> parserZero + _ -> fail $ "Couldn't parse into number with parameters: " ++ show n ++ "," ++ show m pYear :: Stream s m Char => ParsecT s st m Int pYear = do diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -95,6 +95,16 @@ "next thursday" `shouldBe` Right testDateTime { dtDate = (dtDate testDateTime) { dateDay = 19 } } + describe "time" $ + mapM_ (\(str, ans) -> it ("parses the time strings like '" ++ str ++ "'") (parse time "" str `shouldBe` Right ans)) + [ ("13:15", TimeOfDay 13 15 0 0) + , ("8:00 AM", TimeOfDay 8 0 0 0) + , ("9:15", TimeOfDay 9 15 0 0) + , ("00.00.15", TimeOfDay 0 0 15 0) + , ("1:09 PM", TimeOfDay 13 9 0 0) + , ("04.15", TimeOfDay 4 15 0 0) + , ("9 AM", TimeOfDay 9 0 0 0)] + describe "parseDate" $ mapM_ (\(str, ans) -> @@ -120,10 +130,26 @@ , ("DECEMBER 8, -9", Date (-9) December 8) ] - describe "extractDatesY" $ + describe "extractDateTimesY" $ mapM_ (\(str, ans) -> it ("understands '" ++ str ++ "'") (extractDatesY 2018 str `shouldBe` ans)) [ ("2017-08-9", [Date 2017 August 9]) , ("Jan 19", [Date 2018 January 19]) , ("The party will be on 6/9", [Date 2018 June 9]) - , ("Start: November 27, 1993\nEnd: December 5, 1993", [Date 1993 November 27, Date 1993 December 5])] + , ("Start: November 27, 1993\nEnd: December 5, 1993", [Date 1993 November 27, Date 1993 December 5]) + , ("1647-09-5 13:15 or 1913-1-29", [Date 1647 September 5, Date 1913 January 29])] + + -- SHOULD IGNORE TIMES WHEN PARSING DATES, ADD TESTS.... + + describe "extractDatesTimesY" $ do + mapM_ (\(str, ans) -> it ("can also parse plain dates like: '" ++ str ++ "'") (extractDateTimesY 2018 str `shouldBe` ans)) + [ ("2017-08-9", [DateTime {dtDate = Date 2017 August 9, dtTime = TimeOfDay 0 0 0 0}]) + , ("Jan 19", [DateTime {dtDate = Date 2018 January 19, dtTime = TimeOfDay 0 0 0 0}]) + , ("The party will be on 6/9", [DateTime {dtDate = Date 2018 June 9, dtTime = TimeOfDay 0 0 0 0}]) + , ("Start: November 27, 1993\nEnd: December 5, 1993", [DateTime {dtDate = Date 1993 November 27, dtTime = TimeOfDay 0 0 0 0}, DateTime {dtDate = Date 1993 December 5, dtTime = TimeOfDay 0 0 0 0}])] + + mapM_ (\(str, ans) -> it ("understands dates with times like: '" ++ str ++ "'") (extractDateTimesY 2018 str `shouldBe` ans)) + [ ("2017-08-9 08:15", [DateTime {dtDate = Date 2017 August 9, dtTime = TimeOfDay 8 15 0 0}]) + , ("feb 7 3:09:06 AM", [DateTime {dtDate = Date 2018 February 7, dtTime = TimeOfDay 3 9 6 0}]) + , ("This morning, 06.07.16 at 7:35 AM, the fire was stopped.", [DateTime {dtDate = Date 2016 July 6, dtTime = TimeOfDay 7 35 0 0}]) + , ("Date/Time of Birth: August 29, 1765 AD, Date/Time of Death: 30 November 1823 4 PM", [DateTime {dtDate = Date 1765 August 29, dtTime = TimeOfDay 0 0 0 0}, DateTime {dtDate = Date 1823 November 30, dtTime = TimeOfDay 16 0 0 0}])]