todos 0.5.2 → 0.5.3
raw patch · 8 files changed
+22/−319 lines, 8 filesdep +dates
Dependencies added: dates
Files
- Todos/Config.hs +1/−0
- Todos/Dates.hs +4/−270
- Todos/Default/CmdLine.hs +1/−1
- Todos/Default/Utils.hs +1/−0
- Todos/Loader.hs +1/−0
- Todos/Parser.hs +3/−2
- Todos/Types.hs +2/−43
- todos.cabal +9/−3
Todos/Config.hs view
@@ -4,6 +4,7 @@ import Prelude.Unicode import Control.Monad.Reader+import Data.Dates import Todos.Types import Todos.Dot
Todos/Dates.hs view
@@ -5,271 +5,11 @@ pSpecDates) where -import Prelude.Unicode-import Data.Char (toUpper)-import Data.List-import Data.Time.Calendar-import Data.Time.LocalTime-import Text.ParserCombinators.Parsec+import Data.Dates+import Text.Parsec import Todos.Types -getCurrentDateTime ∷ IO DateTime-getCurrentDateTime = do- zt ← getZonedTime- let lt = zonedTimeToLocalTime zt- ld = localDay lt- ltod = localTimeOfDay lt- (y,m,d) = toGregorian ld- h = todHour ltod- mins = todMin ltod- s = round $ todSec ltod- return $ DateTime (fromIntegral y) m d h mins s--uppercase ∷ String → String-uppercase = map toUpper--isPrefixOfI ∷ String → String → Bool-p `isPrefixOfI` s = (uppercase p) `isPrefixOf` (uppercase s)--lookupS ∷ String → [(String,a)] → Maybe a-lookupS _ [] = Nothing-lookupS k ((k',v):other) | k `isPrefixOfI` k' = Just v- | otherwise = lookupS k other--monthsN ∷ [(String,Int)]-monthsN = zip months [1..]--lookupMonth ∷ String → Maybe Int-lookupMonth n = lookupS n monthsN--date ∷ Int → Int → Int → DateTime-date y m d = DateTime y m d 0 0 0--addTime ∷ DateTime → Time → DateTime-addTime dt t = dt {- hour = tHour t + hour dt,- minute = tMinute t + minute dt,- second = tSecond t + second dt }--times ∷ Int → CharParser st t → CharParser st [t]-times 0 _ = return []-times n p = do- ts ← times (n-1) p- t ← optionMaybe p- case t of- Just t' → return (ts ++ [t'])- Nothing → return ts- -number ∷ Int → Int → CharParser st Int-number n m = do- t ← read `fmap` (n `times` digit)- if t > m- then fail "number too large"- else return t--pYear ∷ CharParser st Int-pYear = do- y ← number 4 10000- if y < 2000- then return (y+2000)- else return y--pMonth ∷ CharParser st Int-pMonth = number 2 12--pDay ∷ CharParser st Int-pDay = number 2 31--euroNumDate ∷ CharParser st DateTime-euroNumDate = do- d ← pDay- char '.'- m ← pMonth- char '.'- y ← pYear- return $ date y m d--americanDate ∷ CharParser st DateTime-americanDate = do- y ← pYear- char '/'- m ← pMonth- char '/'- d ← pDay- return $ date y m d--euroNumDate' ∷ Int → CharParser st DateTime-euroNumDate' year = do- d ← pDay- char '.'- m ← pMonth- return $ date year m d--americanDate' ∷ Int → CharParser st DateTime-americanDate' year = do- m ← pMonth- char '/'- d ← pDay- return $ date year m d--strDate ∷ CharParser st DateTime-strDate = do- d ← pDay- space- ms ← many1 letter- case lookupMonth ms of- Nothing → fail $ "unknown month: "++ms- Just m → do- space- y ← pYear- notFollowedBy $ char ':'- return $ date y m d--strDate' ∷ Int → CharParser st DateTime-strDate' year = do- d ← pDay- space- ms ← many1 letter- case lookupMonth ms of- Nothing → fail $ "unknown month: "++ms- Just m → return $ date year m d--time24 ∷ CharParser st Time-time24 = do- h ← number 2 23- char ':'- m ← number 2 59- x ← optionMaybe $ char ':'- case x of- Nothing → return $ Time h m 0- Just _ → do- s ← number 2 59- notFollowedBy letter- return $ Time h m s--ampm ∷ CharParser st Int-ampm = do- s ← many1 letter- case map toUpper s of- "AM" → return 0- "PM" → return 12- _ → fail "AM/PM expected"--time12 ∷ CharParser st Time-time12 = do- h ← number 2 12- char ':'- m ← number 2 59- x ← optionMaybe $ char ':'- s ← case x of- Nothing → return 0- Just _ → number 2 59- optional space- hd ← ampm- return $ Time (h+hd) m s--pAbsDate ∷ Int → CharParser st DateTime-pAbsDate year = do- date ← choice $ map try $ map ($ year) $ [- const euroNumDate,- const americanDate,- const strDate,- strDate',- euroNumDate',- americanDate']- optional $ char ','- s ← optionMaybe space- case s of- Nothing → return date- Just _ → do- t ← choice $ map try [time12,time24]- return $ date `addTime` t--data DateIntervalType = Day | Week | Month | Year- deriving (Eq,Show,Read)--data DateInterval = Days ℤ- | Weeks ℤ- | Months ℤ- | Years ℤ- deriving (Eq,Show)--convertTo ∷ DateTime → Day-convertTo dt = fromGregorian (fromIntegral $ year dt) (month dt) (day dt)--convertFrom ∷ Day → DateTime-convertFrom dt = - let (y,m,d) = toGregorian dt- in date (fromIntegral y) m d--modifyDate ∷ (t → Day → Day) → t → DateTime → DateTime-modifyDate fn x dt = convertFrom $ fn x $ convertTo dt--addInterval ∷ DateTime → DateInterval → DateTime-addInterval dt (Days ds) = modifyDate addDays ds dt-addInterval dt (Weeks ws) = modifyDate addDays (ws*7) dt-addInterval dt (Months ms) = modifyDate addGregorianMonthsClip ms dt-addInterval dt (Years ys) = modifyDate addGregorianYearsClip ys dt--maybePlural ∷ String → CharParser st String-maybePlural str = do- r ← string str- optional $ char 's'- return (capitalize r)--pDateInterval ∷ CharParser st DateIntervalType-pDateInterval = do- s ← choice $ map maybePlural ["day", "week", "month", "year"]- return $ read s--pRelDate ∷ DateTime → CharParser st DateTime-pRelDate date = do- offs ← (try futureDate) <|> (try passDate) <|> (try today) <|> (try tomorrow) <|> yesterday- return $ date `addInterval` offs--futureDate ∷ CharParser st DateInterval-futureDate = do- string "in "- n ← many1 digit- char ' '- tp ← pDateInterval- case tp of- Day → return $ Days (read n)- Week → return $ Weeks (read n)- Month → return $ Months (read n)- Year → return $ Years (read n)--passDate ∷ CharParser st DateInterval-passDate = do- n ← many1 digit- char ' '- tp ← pDateInterval- string " ago"- case tp of- Day → return $ Days $ - (read n)- Week → return $ Weeks $ - (read n)- Month → return $ Months $ - (read n)- Year → return $ Years $ - (read n)--today ∷ CharParser st DateInterval-today = do- string "today"- return $ Days 0--tomorrow ∷ CharParser st DateInterval-tomorrow = do- string "tomorrow"- return $ Days 1--yesterday ∷ CharParser st DateInterval-yesterday = do- string "yesterday"- return $ Days (-1)--pDate ∷ DateTime → CharParser st DateTime-pDate date = (try $ pRelDate date) <|> (try $ pAbsDate $ year date)- dateType ∷ String → DateType dateType "start" = StartDate dateType "end" = EndDate@@ -277,7 +17,7 @@ dateType _ = error "unknown date type" -- | Parse date/time with date type-pSpecDate ∷ DateTime → CharParser st (DateType, DateTime)+pSpecDate ∷ DateTime → Parsec String st (DateType, DateTime) pSpecDate date = do tp ← choice $ map string ["start","end","deadline"] string ": "@@ -285,16 +25,10 @@ return (dateType tp, dt) -- | Parse set of dates with types (in parenthesis)-pSpecDates ∷ DateTime → CharParser st [(DateType, DateTime)]+pSpecDates ∷ DateTime → Parsec String st [(DateType, DateTime)] pSpecDates date = do char '(' pairs ← (pSpecDate date) `sepBy1` (string "; ") string ") " return pairs---- | Parse date/time-parseDate ∷ DateTime -- ^ Current date/time- → String -- ^ String to parse- → Either ParseError DateTime-parseDate date s = runParser (pDate date) () "" s
Todos/Default/CmdLine.hs view
@@ -16,12 +16,12 @@ import System.FilePath.Glob hiding (glob) import Data.Maybe import Data.List (sort)+import Data.Dates import Todos.IO import Todos.Types import Todos.Tree import Todos.Default.Config-import Todos.Dates (parseDate) -- | Compose predicate from Composed compose ∷ DateTime -- ^ Current date/time
Todos/Default/Utils.hs view
@@ -3,6 +3,7 @@ module Todos.Default.Utils where import System.Console.ANSI+import Data.Dates import Todos.Types import Todos.Dot
Todos/Loader.hs view
@@ -12,6 +12,7 @@ import Data.Maybe import Data.Tree import Data.List (nub, sort)+import Data.Dates import Todos.IO import Todos.Types
Todos/Parser.hs view
@@ -6,15 +6,16 @@ import Prelude hiding (putStrLn,readFile,getContents,print) import Prelude.Unicode import Data.List-import Text.ParserCombinators.Parsec+import Text.Parsec import Data.Char+import Data.Dates import Text.Regex.PCRE import Todos.Types import Todos.Dates import Todos.Config -type TParser a = GenParser Char BaseConfig a+type TParser a = Parsec String BaseConfig a strip ∷ String → String strip = reverse ∘ p ∘ reverse ∘ p
Todos/Types.hs view
@@ -12,8 +12,9 @@ import Data.Maybe import Data.Tree import Data.List+import Data.Dates import qualified Data.Map as M-import Text.ParserCombinators.Parsec+import Text.Parsec import Numeric type 𝔹 = Bool@@ -29,52 +30,10 @@ show EndDate = "end" show Deadline = "deadline" -data DateTime =- DateTime {- year ∷ Int,- month ∷ Int,- day ∷ Int,- hour ∷ Int,- minute ∷ Int,- second ∷ Int }- deriving (Eq,Ord,Data,Typeable)---- | 12 months names.-months ∷ [String]-months = ["january",- "february",- "march",- "april",- "may",- "june",- "july",- "august",- "september",- "october",- "november",- "december"]- -- | capitalize first letter of the string capitalize ∷ String → String capitalize [] = [] capitalize (x:xs) = (toUpper x):xs---- | Show name of given month-showMonth ∷ Int → String-showMonth i = capitalize $ months !! (i-1)--instance Show DateTime where- show (DateTime y m d h mins s) = - show d ⧺ " " ⧺ showMonth m ⧺ " " ⧺ show y ⧺ ", " ⧺- show h ⧺ ":" ⧺ show mins ⧺ ":" ⧺ show s---- | Only time, without date-data Time = - Time {- tHour ∷ Int,- tMinute ∷ Int,- tSecond ∷ Int }- deriving (Eq,Ord,Show,Data,Typeable) -- | TODO item itself. data TodoItem = Item {
todos.cabal view
@@ -1,6 +1,6 @@ Name: todos-Version: 0.5.2-Cabal-Version: >= 1.6+Version: 0.5.3+Cabal-Version: >= 1.8 License: BSD3 License-File: LICENSE Author: Ilya V. Portnov@@ -44,7 +44,8 @@ Build-Depends: base >= 3 && <= 5, containers, parsec >= 3, syb, mtl, ansi-terminal, Glob, time, regex-pcre, directory, filepath,- process, data-hash, dyre, utf8-string, base-unicode-symbols >= 0.2.2.1+ process, data-hash, dyre, utf8-string, base-unicode-symbols >= 0.2.2.1,+ dates ==0.1.* if flag(with_curses) Exposed-Modules: Todos.Default.Curses@@ -77,6 +78,11 @@ Todos.Tree Todos.Types Todos.Formatters++ Build-Depends: base >= 3 && <= 5, containers, parsec >= 3,+ syb, mtl, ansi-terminal, Glob, time, regex-pcre, directory, filepath,+ process, data-hash, dyre, utf8-string, base-unicode-symbols >= 0.2.2.1,+ dates >=0.1.1.0 Source-repository head type: git