Try out several things
This commit is contained in:
parent
5e1555511d
commit
163d08cf79
7 changed files with 173 additions and 54 deletions
57
app/Main.hs
57
app/Main.hs
|
|
@ -8,36 +8,43 @@ import System.Exit
|
||||||
|
|
||||||
import qualified Brick.Themes as B
|
import qualified Brick.Themes as B
|
||||||
import qualified Options.Applicative as O
|
import qualified Options.Applicative as O
|
||||||
|
import qualified Database.SQLite.Simple as DB
|
||||||
|
|
||||||
import qualified TaskMachine.UI as TM
|
import qualified TaskMachine.UI as TM
|
||||||
|
import qualified TaskMachine.Database as TM
|
||||||
|
|
||||||
|
-- TODO: When adding oConfigFile back, make oTaskDB a Maybe FilePath.
|
||||||
|
-- This way, it won't always overwrite the task db set in the config.
|
||||||
|
-- TODO: Add a [-c|--export-default-config CONFIGFILE] option
|
||||||
|
-- TODO: Add a [--initialize] flag to create a ~/.taskmachine/ folder and fill it with a default config and theme.
|
||||||
|
-- TODO: Have a look at other programs to see how they deal with this issue.
|
||||||
data Options = Options
|
data Options = Options
|
||||||
{ oConfigFile :: FilePath
|
-- { oConfigFile :: FilePath
|
||||||
, oTaskDB :: FilePath
|
{ oTaskDB :: FilePath
|
||||||
, oThemePaths :: [FilePath]
|
, oThemePaths :: [FilePath]
|
||||||
, oExportDefaultTheme :: [FilePath]
|
, oExportDefaultTheme :: [FilePath]
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
argParser :: O.Parser Options
|
argParser :: O.Parser Options
|
||||||
argParser = pure Options
|
argParser = pure Options
|
||||||
<*> configFile
|
-- <*> configFile
|
||||||
<*> taskDB
|
<*> taskDB
|
||||||
<*> many themePaths
|
<*> many themePaths
|
||||||
<*> many exportDefaultTheme
|
<*> many exportDefaultTheme
|
||||||
where
|
where
|
||||||
configFile = O.strOption $ mconcat
|
-- configFile = O.strOption $ mconcat
|
||||||
[ O.short 'c'
|
-- [ O.short 'c'
|
||||||
, O.long "config"
|
-- , O.long "config"
|
||||||
, O.help "Specify the config file to be loaded."
|
-- , O.help "Specify the config file to be loaded."
|
||||||
, O.value "tasks.config"
|
-- , O.value "tasks.config"
|
||||||
, O.showDefault
|
-- , O.showDefault
|
||||||
, O.metavar "CONFIGFILE"
|
-- , O.metavar "CONFIGFILE"
|
||||||
]
|
-- ]
|
||||||
taskDB = O.strOption $ mconcat
|
taskDB = O.strOption $ mconcat
|
||||||
[ O.short 'd'
|
[ O.short 'd'
|
||||||
, O.long "task-db"
|
, O.long "task-db"
|
||||||
, O.help "Specify the database file where the tasks are saved."
|
, O.help "Specify the database file where the tasks are saved."
|
||||||
, O.value "tasks.db"
|
, O.value "~/.taskmanager/tasks.db"
|
||||||
, O.showDefault
|
, O.showDefault
|
||||||
, O.metavar "TASKDB"
|
, O.metavar "TASKDB"
|
||||||
]
|
]
|
||||||
|
|
@ -79,26 +86,28 @@ main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
options <- O.execParser argParserInfo
|
options <- O.execParser argParserInfo
|
||||||
|
|
||||||
-- Good ol' debug print
|
|
||||||
when True $ do
|
|
||||||
putStrLn "- The Options -"
|
|
||||||
print options
|
|
||||||
putStrLn "- The End -"
|
|
||||||
putStrLn ""
|
|
||||||
|
|
||||||
-- Export default theme
|
-- Export default theme
|
||||||
forM_ (oExportDefaultTheme options) $ \path -> do
|
forM_ (oExportDefaultTheme options) $ \path -> do
|
||||||
action $ "Exporting default theme to " ++ show path ++ "."
|
action $ "Exporting default theme to " ++ show path ++ "."
|
||||||
B.saveTheme path TM.defaultTheme
|
B.saveTheme path TM.defaultTheme
|
||||||
|
|
||||||
-- Load config
|
-- Export default config
|
||||||
-- TODO: Some config data type that contains the themes etc.
|
-- TODO
|
||||||
|
|
||||||
-- Load themes and connect to db
|
-- Load config
|
||||||
|
-- TODO
|
||||||
|
|
||||||
|
-- Add command line options into config
|
||||||
|
-- TODO
|
||||||
|
|
||||||
|
-- According to config, load themes and connect to db
|
||||||
theme <- loadThemes TM.defaultTheme $ oThemePaths options
|
theme <- loadThemes TM.defaultTheme $ oThemePaths options
|
||||||
|
|
||||||
-- Running the program
|
-- Do some debugging stuff or something
|
||||||
error "Implement actual program logic" theme
|
DB.withConnection "test.db" TM.initializeNewDB
|
||||||
|
|
||||||
|
-- Start the UI
|
||||||
|
error "Implement UI" theme
|
||||||
|
|
||||||
--import qualified Database.SQLite.Simple as DB
|
--import qualified Database.SQLite.Simple as DB
|
||||||
--import qualified TaskMachine.Database as TMD
|
--import qualified TaskMachine.Database as TMD
|
||||||
|
|
|
||||||
|
|
@ -21,6 +21,8 @@ description: Please see the README on Github at <https://github.com/Garm
|
||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
|
- text
|
||||||
|
- time
|
||||||
- sqlite-simple
|
- sqlite-simple
|
||||||
- brick
|
- brick
|
||||||
- vty
|
- vty
|
||||||
|
|
|
||||||
|
|
@ -1,6 +0,0 @@
|
||||||
module Lib
|
|
||||||
( someFunc
|
|
||||||
) where
|
|
||||||
|
|
||||||
someFunc :: IO ()
|
|
||||||
someFunc = putStrLn "someFunc"
|
|
||||||
|
|
@ -1,17 +1,64 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
|
||||||
module TaskMachine.Database
|
module TaskMachine.Database
|
||||||
( initializeNewDB
|
( TaskRow(..)
|
||||||
|
, initializeNewDB
|
||||||
) where
|
) where
|
||||||
|
|
||||||
--import qualified Data.Text as T
|
--import Control.Exception
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import Data.Time.Calendar
|
||||||
import qualified Database.SQLite.Simple as DB
|
import qualified Database.SQLite.Simple as DB
|
||||||
|
|
||||||
|
import qualified TaskMachine.DateExpr as TM
|
||||||
|
|
||||||
|
data TaskRow = TaskRow
|
||||||
|
{ rowID :: Integer
|
||||||
|
, rowDeadline :: Maybe Day
|
||||||
|
, rowFormula :: Maybe TM.DateExpr
|
||||||
|
, rowDescription :: T.Text
|
||||||
|
, rowDetails :: T.Text
|
||||||
|
, rowRepetitionsTotal :: Integer
|
||||||
|
, rowRepetitionsDone :: Integer
|
||||||
|
}
|
||||||
|
|
||||||
|
instance DB.ToRow TaskRow where
|
||||||
|
toRow TaskRow{..} = DB.toRow
|
||||||
|
( rowID
|
||||||
|
, rowDeadline
|
||||||
|
, rowFormula
|
||||||
|
, rowDescription
|
||||||
|
, rowDetails
|
||||||
|
, rowRepetitionsTotal
|
||||||
|
, rowRepetitionsDone
|
||||||
|
)
|
||||||
|
|
||||||
|
instance DB.FromRow TaskRow where
|
||||||
|
fromRow = do
|
||||||
|
(a,b,c,d,e,f,g) <- DB.fromRow
|
||||||
|
let rowID = a
|
||||||
|
rowDeadline = b
|
||||||
|
rowFormula = c
|
||||||
|
rowDescription = d
|
||||||
|
rowDetails = e
|
||||||
|
rowRepetitionsTotal = f
|
||||||
|
rowRepetitionsDone = g
|
||||||
|
return TaskRow{..}
|
||||||
|
|
||||||
|
-- TODO: Maybe put this in separate module and/or make less specific
|
||||||
|
--allowErrorConstraint :: IO () -> IO ()
|
||||||
|
--allowErrorConstraint = handleJust isErrorConstraint (const $ return ())
|
||||||
|
-- where
|
||||||
|
-- isErrorConstraint DB.SQLError{DB.sqlError=DB.ErrorConstraint} = Just ()
|
||||||
|
-- isErrorConstraint _ = Nothing
|
||||||
|
|
||||||
initializeNewDB :: DB.Connection -> IO ()
|
initializeNewDB :: DB.Connection -> IO ()
|
||||||
initializeNewDB c = do
|
initializeNewDB c = do
|
||||||
DB.execute_ c createTaskTable
|
DB.execute_ c createTaskTable
|
||||||
DB.execute_ c createVersionTable
|
-- DB.execute_ c createVersionTable
|
||||||
DB.execute c fillVersionTable (DB.Only (1 :: Integer))
|
-- allowErrorConstraint $ DB.execute c fillVersionTable (DB.Only (1 :: Integer))
|
||||||
where
|
where
|
||||||
createTaskTable =
|
createTaskTable =
|
||||||
"CREATE TABLE IF NOT EXISTS tasks (\
|
"CREATE TABLE IF NOT EXISTS tasks (\
|
||||||
|
|
@ -19,12 +66,13 @@ initializeNewDB c = do
|
||||||
\ deadline TEXT,\
|
\ deadline TEXT,\
|
||||||
\ formula TEXT,\
|
\ formula TEXT,\
|
||||||
\ description TEXT NOT NULL,\
|
\ description TEXT NOT NULL,\
|
||||||
|
\ details TEXT NOT NULL DEFAULT \"\",\
|
||||||
\ repetitions_total INTEGER NOT NULL DEFAULT 1,\
|
\ repetitions_total INTEGER NOT NULL DEFAULT 1,\
|
||||||
\ repetitions_done INTEGER NOT NULL DEFAULT 0\
|
\ repetitions_done INTEGER NOT NULL DEFAULT 0\
|
||||||
\)"
|
\)"
|
||||||
createVersionTable =
|
-- createVersionTable =
|
||||||
"CREATE TABLE version (\
|
-- "CREATE TABLE IF NOT EXISTS version (\
|
||||||
\ version_number INTEGER\
|
-- \ version_number INTEGER PRIMARY KEY\
|
||||||
\)"
|
-- \)"
|
||||||
fillVersionTable =
|
-- fillVersionTable =
|
||||||
"INSERT INTO version (version_number) VALUES (?)"
|
-- "INSERT INTO version (version_number) VALUES (?)"
|
||||||
|
|
|
||||||
39
src/TaskMachine/DateExpr.hs
Normal file
39
src/TaskMachine/DateExpr.hs
Normal file
|
|
@ -0,0 +1,39 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module TaskMachine.DateExpr
|
||||||
|
( DateExpr
|
||||||
|
, parse
|
||||||
|
, save
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Exception
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Database.SQLite.Simple as DB
|
||||||
|
import qualified Database.SQLite.Simple.FromField as DB
|
||||||
|
import qualified Database.SQLite.Simple.Ok as DB
|
||||||
|
import qualified Database.SQLite.Simple.ToField as DB
|
||||||
|
|
||||||
|
data DateExpr = DummyValue
|
||||||
|
|
||||||
|
parse :: T.Text -> Maybe DateExpr
|
||||||
|
parse = const (Just DummyValue)
|
||||||
|
|
||||||
|
save :: DateExpr -> T.Text
|
||||||
|
save = const "dummy string"
|
||||||
|
|
||||||
|
|
||||||
|
data DummyException = DummyException
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
instance Exception DummyException
|
||||||
|
|
||||||
|
instance DB.ToField DateExpr where
|
||||||
|
toField = DB.SQLText . save
|
||||||
|
|
||||||
|
instance DB.FromField DateExpr where
|
||||||
|
fromField f = case DB.fromField f of
|
||||||
|
DB.Errors e -> DB.Errors e
|
||||||
|
DB.Ok text -> case parse text of
|
||||||
|
Nothing -> DB.Errors [SomeException DummyException] -- TODO: Use proper exception
|
||||||
|
Just expr -> DB.Ok expr
|
||||||
15
src/TaskMachine/Types.hs
Normal file
15
src/TaskMachine/Types.hs
Normal file
|
|
@ -0,0 +1,15 @@
|
||||||
|
module TaskMachine.Types
|
||||||
|
( Config(..)
|
||||||
|
, defaultConfig
|
||||||
|
) where
|
||||||
|
|
||||||
|
data Config = Config
|
||||||
|
{ cThemes :: [FilePath]
|
||||||
|
, cTaskDB :: FilePath
|
||||||
|
}
|
||||||
|
|
||||||
|
defaultConfig :: Config
|
||||||
|
defaultConfig = Config
|
||||||
|
{ cThemes = []
|
||||||
|
, cTaskDB = "~/.taskmachine/tasks.db"
|
||||||
|
}
|
||||||
|
|
@ -1,8 +1,6 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module TaskMachine.UI
|
module TaskMachine.UI where
|
||||||
( defaultTheme
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
|
|
||||||
|
|
@ -10,15 +8,29 @@ import qualified Brick as B
|
||||||
import qualified Brick.Themes as B
|
import qualified Brick.Themes as B
|
||||||
import qualified Graphics.Vty as VTY
|
import qualified Graphics.Vty as VTY
|
||||||
|
|
||||||
|
import qualified TaskMachine.Types as TM
|
||||||
|
|
||||||
defaultTheme :: B.Theme
|
defaultTheme :: B.Theme
|
||||||
defaultTheme = B.newTheme VTY.defAttr
|
defaultTheme = B.newTheme VTY.defAttr
|
||||||
[ ("taskList" <> "normal", withStyle VTY.bold $ B.fg VTY.cyan)
|
[ ("taskList" <> "normal", withStyle VTY.bold $ B.fg VTY.cyan)
|
||||||
, ("taskList" <> "highlight", withStyle VTY.bold $ B.bg VTY.cyan)
|
, ("taskList" <> "highlight", B.bg VTY.cyan)
|
||||||
, ("taskList" <> "urgent" <> "normal", withStyle VTY.bold $ B.fg VTY.yellow)
|
|
||||||
, ("taskList" <> "urgent" <> "highlight", withStyle VTY.bold $ B.bg VTY.yellow)
|
|
||||||
, ("taskList" <> "veryUrgent" <> "normal", withStyle VTY.bold $ B.fg VTY.red)
|
|
||||||
, ("taskList" <> "veryUrgent" <> "highlight", withStyle VTY.bold $ B.bg VTY.red)
|
|
||||||
, ("taskList" <> "overdue" <> "normal", withStyle VTY.bold $ B.fg VTY.magenta)
|
|
||||||
, ("taskList" <> "overdue" <> "highlight", withStyle VTY.bold $ B.bg VTY.magenta)
|
|
||||||
]
|
]
|
||||||
where withStyle = flip VTY.withStyle
|
where withStyle = flip VTY.withStyle
|
||||||
|
|
||||||
|
data ResourceName = Asdf
|
||||||
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
|
data State = State
|
||||||
|
{ sConfig :: TM.Config
|
||||||
|
}
|
||||||
|
|
||||||
|
myApp :: B.App () () ResourceName
|
||||||
|
myApp = B.App
|
||||||
|
{ B.appDraw = \_ -> [myTestWidget]
|
||||||
|
, B.appHandleEvent = B.resizeOrQuit
|
||||||
|
, B.appStartEvent = \s -> return s
|
||||||
|
, B.appChooseCursor = B.neverShowCursor
|
||||||
|
, B.appAttrMap = const $ B.themeToAttrMap defaultTheme
|
||||||
|
}
|
||||||
|
where
|
||||||
|
myTestWidget = B.withAttr ("taskList" <> "normal") (B.str "normal ") B.<+> B.withAttr ("taskList" <> "highlight") (B.str "style")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue