module Todos.Types where
import Prelude hiding (putStr, putStrLn,readFile,getContents,print)
import Prelude.Unicode
import Data.Hash
import Data.Function
import Data.Generics hiding (GT)
import Data.Char (toUpper)
import Data.Maybe
import Data.Tree
import Data.List
import qualified Data.Map as M
import Text.ParserCombinators.Parsec
import Numeric
type 𝔹 = Bool
data DateType = StartDate
| EndDate
| Deadline
deriving (Eq)
instance Show DateType where
show StartDate = "start"
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)
months ∷ [String]
months = ["january",
"february",
"march",
"april",
"may",
"june",
"july",
"august",
"september",
"october",
"november",
"december"]
capitalize ∷ String → String
capitalize [] = []
capitalize (x:xs) = (toUpper x):xs
showMonth ∷ Int → String
showMonth i = capitalize $ months !! (i1)
instance Show DateTime where
show (DateTime y m d h mins s) =
show d ⧺ " " ⧺ showMonth m ⧺ " " ⧺ show y ⧺ ", " ⧺
show h ⧺ ":" ⧺ show mins ⧺ ":" ⧺ show s
data Time =
Time {
tHour ∷ Int,
tMinute ∷ Int,
tSecond ∷ Int }
deriving (Eq,Ord,Show,Data,Typeable)
data TodoItem = Item {
itemLevel ∷ ℤ,
itemPrefix ∷ String,
itemName ∷ String,
itemTags ∷ [String],
depends ∷ [String],
itemStatus ∷ String,
itemDescr ∷ String,
startDate ∷ Maybe DateTime,
endDate ∷ Maybe DateTime,
deadline ∷ Maybe DateTime,
fileName ∷ FilePath,
lineNr ∷ Line,
itemNumber ∷ ℤ
}
deriving (Eq,Data,Typeable)
instance Hashable TodoItem where
hash item = foldl1 combine $ map ($ item) [hash ∘ itemName, hash ∘ itemDescr,
hash ∘ itemTags, hash ∘ itemStatus]
makeId :: (Hashable a) ⇒ a → String
makeId item =
let s = showHex (asWord64 $ hash item) ""
l = length s
in if l < 16
then replicate (16l) '0' ++ s
else s
type Todo = Tree TodoItem
type TodoMap = M.Map String Todo
data Limit = Unlimited
| Limit {unLimit ∷ ℤ}
deriving (Eq,Show)
instance Ord Limit where
compare Unlimited Unlimited = EQ
compare Unlimited _ = GT
compare _ Unlimited = LT
compare (Limit x) (Limit y) = compare x y
data CmdLineFlag = QF {queryFlag ∷ QueryFlag}
| MF {modeFlag ∷ ModeFlag}
| OF {outFlag ∷ OutFlag}
| LF {limFlag ∷ LimitFlag}
| HelpF
deriving (Eq,Show)
data QueryFlag = Tag String
| Name {unName ∷ String}
| IdIs String
| Status String
| Description String
| StartDateIs DateTime
| EndDateIs DateTime
| DeadlineIs DateTime
| AndCons
| OrCons
| NotCons
| NoFilter
deriving (Eq,Ord,Show)
data LimitFlag = Prune {unPrune ∷ ℤ}
| Start {unMin ∷ ℤ}
deriving (Eq,Show)
data ModeFlag = Execute {unExecute ∷ String}
| Prefix {unPrefix ∷ String}
| Format {getFormat ∷ String}
| DoNotReadStatus
| SetStatus {newStatus ∷ String}
| SetTopStatus {newTopStatus ∷ String}
| GroupByFile
| GroupByTag
| GroupByStatus
deriving (Eq,Ord,Show)
data OutFlag = OnlyFirst
| Colors
| Highlight
| Ids
| DotExport
| IndentWith {getIndentString ∷ String}
| Sort {getSorting ∷ SortingType}
deriving (Eq,Ord,Show)
data SortingType = DoNotSort
| ByTitle
| ByStatus
| ByTags
| ByStartDate
| ByEndDate
| ByDeadline
deriving (Eq,Ord,Show)
readSort ∷ String → SortingType
readSort "no" = DoNotSort
readSort "title" = ByTitle
readSort "status" = ByStatus
readSort "tags" = ByTags
readSort "start-date" = ByStartDate
readSort "end-date" = ByEndDate
readSort "deadline" = ByDeadline
readSort s = error $ "Unknown sorting type: "++s
instance (Ord a) ⇒ Ord (Tree a) where
compare = compare `on` rootLabel
data Options = O [QueryFlag] [ModeFlag] [OutFlag] [LimitFlag]
| Help
data TodoCommand =
JustShow
| ShowAsDot
| SystemCommand String
deriving (Eq, Show)
data Composed = Pred QueryFlag
| And Composed Composed
| Or Composed Composed
| Not Composed
| Empty
| HelpC
deriving (Eq,Show)
is ∷ (Functor f) ⇒ t → f a → f (t, a)
t `is` x = (\a → (t,a)) `fmap` x
showDate ∷ (DateType, DateTime) → String
showDate (t,d) = show t ⧺ ": " ⧺ show d
showDates ∷ [Maybe (DateType, DateTime)] → String
showDates = intercalate "; " ∘ map showDate ∘ catMaybes
instance Show TodoItem where
show item = s ⧺ " " ⧺ dates ⧺ tags ⧺ name ⧺ (if null descr then "" else " "⧺descr)
where
name = itemName item
ts = itemTags item
s = itemStatus item
descr = itemDescr item
dates | null dates' = ""
| otherwise = "(" ⧺ dates' ⧺ ") "
dates' = showDates [StartDate `is` startDate item, EndDate `is` endDate item, Deadline `is` deadline item]
tags = if null ts
then ""
else "[" ⧺ (unwords ts) ⧺ "] "
instance Ord TodoItem where
compare item1 item2 =
let c1 = (compare `on` itemLevel) item1 item2
c2 = (compare `on` itemStatus) item1 item2
c3 = (compare `on` itemName) item1 item2
in if c1 == EQ
then if c2 == EQ
then c3
else c2
else c1