{-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}
module TaskMonad.GridSelect
(
taskSelect
, taskSelectWithConfig
, tagSelect
, tagSelectWithConfig
, projectSelect
, projectSelectWithConfig
, dueSelect
, dueSelectWithConfig
, togglePriority
, togglePriorityWithConfig
,
buildTWGSExtraConfig
, buildTWGSConfig
, defaultTWGSConfig
, defaultTWGSExtraConfig
)
where
import Data.List
import Data.Maybe
import System.Process
import System.IO
import Control.Monad ( filterM )
import XMonad hiding ( liftX )
import XMonad.Util.Font
import qualified XMonad.StackSet as W
import XMonad.Layout.Decoration
import XMonad.Prompt
import XMonad.Prompt.Input
import XMonad.Util.Image
import XMonad.Util.NamedWindows
import XMonad.Util.XUtils
import XMonad.Util.NamedScratchpad
import XMonad.Util.Run
import XMonad.Actions.GridSelect
import qualified GridSelect.Extras
import TaskMonad.Utils
import TaskMonad.ScratchPad
taskSelectWithConfig
:: String
-> GSConfig (X ())
-> X ()
taskSelectWithConfig filter gsConfig =
io (getTaskwarriorTaskList filter ["id", "description"]) >>= \bs -> case bs of
[] -> safeSpawn "firefox" []
_ -> runSelectedAction gsConfig . finishGS $ fmap openBuffer bs
where
finishGS = (("[Finish]", unsafeSpawn "") :)
openBuffer x = (x !! 1, twscratchpad (head x ++ " information"))
taskSelect
:: String
-> X ()
taskSelect filter = taskSelectWithConfig filter (buildTWGSConfig 300)
tagSelectWithConfig
:: (GSConfig (X ()), GSConfig (X ()))
-> X ()
tagSelectWithConfig (fstGsConfig, sndGsConfig) =
io (getTaskwarriorIds "status:pending" "tags") >>= \bs -> case bs of
[] -> safeSpawn "firefox" []
_ -> runSelectedAction fstGsConfig . finishGS $ fmap openBuffer
(filteredTags bs)
where
finishGS = (("[Finish]", unsafeSpawn "") :)
openBuffer x = (x, taskSelectWithConfig ("+" ++ x) sndGsConfig)
filteredTags bs = [ x | x <- bs, x `notElem` hiddenTags ]
hiddenTags =
[ "BLOCKED"
, "UNBLOCKED"
, "UNBLOCKED"
, "DUE"
, "DUETODAY"
, "TODAY"
, "OVERDUE"
, "WEEK"
, "MONTH"
, "QUARTER"
, "YEAR"
, "ACTIVE"
, "SCHEDULED"
, "PARENT"
, "CHILD"
, "UNTIL"
, "WAITING"
, "ANNOTATED"
, "READY"
, "YESTERDAY"
, "TOMORROW"
, "TAGGED"
, "PENDING"
, "COMPLETED"
, "DELETED"
, "UDA"
, "ORPHAN"
, "PRIORITY"
, "PROJECT"
, "LATEST"
, "nocal"
, "nonag"
, "nocolor"
]
tagSelect :: X ()
tagSelect = tagSelectWithConfig (defaultTWGSConfig, buildTWGSConfig 300)
projectSelectWithConfig
:: (GSConfig (X ()), GSConfig (X ()))
-> X ()
projectSelectWithConfig (fstGsConfig, sndGsConfig) =
io (getTaskwarriorIds "status:pending" "projects") >>= \bs -> case bs of
[] -> safeSpawn "firefox" []
_ -> runSelectedAction fstGsConfig . finishGS $ fmap openBuffer bs
where
finishGS = (("[Finish]", unsafeSpawn "") :)
openBuffer x = (x, taskSelectWithConfig ("project:" ++ x) sndGsConfig)
projectSelect :: X ()
projectSelect =
projectSelectWithConfig (defaultTWGSConfig, buildTWGSConfig 300)
dueSelectWithConfig
:: (GSConfig (X ()), GSConfig (X ()))
-> X ()
dueSelectWithConfig (fstGsConfig, sndGsConfig) = runSelectedAction
fstGsConfig
actions
where
actions =
[ ("overdue" , taskSelectWithConfig "+OVERDUE" sndGsConfig)
, ("today" , taskSelectWithConfig "+TODAY" sndGsConfig)
, ("tomorrow", taskSelectWithConfig "+TOMORROW" sndGsConfig)
, ("week" , taskSelectWithConfig "+WEEK" sndGsConfig)
, ("month" , taskSelectWithConfig "+MONTH" sndGsConfig)
, ("year" , taskSelectWithConfig "+YEAR" sndGsConfig)
]
dueSelect :: X ()
dueSelect = dueSelectWithConfig (defaultTWGSConfig, buildTWGSConfig 300)
togglePriority
:: String
-> X ()
togglePriority = togglePriorityWithConfig (buildTWGSExtraConfig 300)
togglePriorityWithConfig
:: GridSelect.Extras.GSConfig (X ())
-> String
-> X ()
togglePriorityWithConfig gsConfig priority =
io (getTaskwarriorTaskList "+INBOX" ["id", "description", "priority"])
>>= \bs -> case bs of
[] -> safeSpawn "firefox" []
_ ->
GridSelect.Extras.runSelectedActionWithMessageAndIcon
gsConfig
("Select " ++ priority ++ "s")
twicon
. startEmacs
$ fmap (openBuffer priority) bs
where
startEmacs = (("[Finish]", safeSpawn "task" []) :)
openBuffer priority x =
( if x !! 2 /= "" then x !! 2 ++ ": " ++ x !! 1 else x !! 1
, toggleP priority x
)
toggleP priority x = if x !! 2 == priority
then unsafeSpawn ("task " ++ head x ++ " modify priority:")
>> togglePriority priority
else unsafeSpawn ("task " ++ head x ++ " modify priority:" ++ priority)
>> togglePriority priority
buildTWGSExtraConfig
:: Integer
-> GridSelect.Extras.GSConfig (X ())
buildTWGSExtraConfig cellwidth = GridSelect.Extras.def
{ GridSelect.Extras.gs_cellheight = 50
, GridSelect.Extras.gs_cellwidth = cellwidth
, GridSelect.Extras.gs_cellpadding = 10
, GridSelect.Extras.gs_font = "xft:Liberation Mono:size=9:antialias=true"
, GridSelect.Extras.gs_navigate = GridSelect.Extras.defaultNavigation
, GridSelect.Extras.gs_originFractX = 1 / 2
, GridSelect.Extras.gs_originFractY = 1 / 2
}
buildTWGSConfig
:: Integer
-> GSConfig (X ())
buildTWGSConfig cellwidth = (buildDefaultGSConfig myColorizer)
{ gs_cellheight = 50
, gs_cellwidth = cellwidth
, gs_cellpadding = 10
, gs_font = "xft:Liberation Mono:size=9:antialias=true"
, gs_navigate = defaultNavigation
, gs_originFractX = 1 / 2
, gs_originFractY = 1 / 2
}
where
myColorizer :: a -> Bool -> X (String, String)
myColorizer _ p | p = pure ("#f44336", "#1a1a1a")
| otherwise = pure ("#1a1a1a", "gray")
defaultTWGSExtraConfig :: GridSelect.Extras.GSConfig (X ())
defaultTWGSExtraConfig = buildTWGSExtraConfig 130
defaultTWGSConfig :: GSConfig (X ())
defaultTWGSConfig = buildTWGSConfig 130