From 163d08cf799f287da919eeafa42cfb379694f942 Mon Sep 17 00:00:00 2001 From: Joscha Date: Mon, 19 Mar 2018 18:39:15 +0000 Subject: [PATCH] Try out several things --- app/Main.hs | 57 ++++++++++++++++++------------- package.yaml | 2 ++ src/Lib.hs | 6 ---- src/TaskMachine/Database.hs | 68 +++++++++++++++++++++++++++++++------ src/TaskMachine/DateExpr.hs | 39 +++++++++++++++++++++ src/TaskMachine/Types.hs | 15 ++++++++ src/TaskMachine/UI.hs | 40 ++++++++++++++-------- 7 files changed, 173 insertions(+), 54 deletions(-) delete mode 100644 src/Lib.hs create mode 100644 src/TaskMachine/DateExpr.hs create mode 100644 src/TaskMachine/Types.hs diff --git a/app/Main.hs b/app/Main.hs index 8ca0980..cfb3f7e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,36 +8,43 @@ import System.Exit import qualified Brick.Themes as B import qualified Options.Applicative as O +import qualified Database.SQLite.Simple as DB 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 - { oConfigFile :: FilePath - , oTaskDB :: FilePath +-- { oConfigFile :: FilePath + { oTaskDB :: FilePath , oThemePaths :: [FilePath] , oExportDefaultTheme :: [FilePath] } deriving (Show) argParser :: O.Parser Options argParser = pure Options - <*> configFile +-- <*> configFile <*> taskDB <*> many themePaths <*> many exportDefaultTheme where - configFile = O.strOption $ mconcat - [ O.short 'c' - , O.long "config" - , O.help "Specify the config file to be loaded." - , O.value "tasks.config" - , O.showDefault - , O.metavar "CONFIGFILE" - ] +-- configFile = O.strOption $ mconcat +-- [ O.short 'c' +-- , O.long "config" +-- , O.help "Specify the config file to be loaded." +-- , O.value "tasks.config" +-- , O.showDefault +-- , O.metavar "CONFIGFILE" +-- ] taskDB = O.strOption $ mconcat [ O.short 'd' , O.long "task-db" , O.help "Specify the database file where the tasks are saved." - , O.value "tasks.db" + , O.value "~/.taskmanager/tasks.db" , O.showDefault , O.metavar "TASKDB" ] @@ -79,26 +86,28 @@ main :: IO () main = do options <- O.execParser argParserInfo - -- Good ol' debug print - when True $ do - putStrLn "- The Options -" - print options - putStrLn "- The End -" - putStrLn "" - -- Export default theme forM_ (oExportDefaultTheme options) $ \path -> do action $ "Exporting default theme to " ++ show path ++ "." B.saveTheme path TM.defaultTheme - -- Load config - -- TODO: Some config data type that contains the themes etc. + -- Export default config + -- 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 - -- Running the program - error "Implement actual program logic" theme + -- Do some debugging stuff or something + DB.withConnection "test.db" TM.initializeNewDB + + -- Start the UI + error "Implement UI" theme --import qualified Database.SQLite.Simple as DB --import qualified TaskMachine.Database as TMD diff --git a/package.yaml b/package.yaml index cf4e48f..405d31a 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,8 @@ description: Please see the README on Github at = 4.7 && < 5 +- text +- time - sqlite-simple - brick - vty diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 index d36ff27..0000000 --- a/src/Lib.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Lib - ( someFunc - ) where - -someFunc :: IO () -someFunc = putStrLn "someFunc" diff --git a/src/TaskMachine/Database.hs b/src/TaskMachine/Database.hs index 487d9cc..4d46953 100644 --- a/src/TaskMachine/Database.hs +++ b/src/TaskMachine/Database.hs @@ -1,17 +1,64 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module TaskMachine.Database - ( initializeNewDB + ( TaskRow(..) + , initializeNewDB ) 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 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 c = do DB.execute_ c createTaskTable - DB.execute_ c createVersionTable - DB.execute c fillVersionTable (DB.Only (1 :: Integer)) +-- DB.execute_ c createVersionTable +-- allowErrorConstraint $ DB.execute c fillVersionTable (DB.Only (1 :: Integer)) where createTaskTable = "CREATE TABLE IF NOT EXISTS tasks (\ @@ -19,12 +66,13 @@ initializeNewDB c = do \ deadline TEXT,\ \ formula TEXT,\ \ description TEXT NOT NULL,\ + \ details TEXT NOT NULL DEFAULT \"\",\ \ repetitions_total INTEGER NOT NULL DEFAULT 1,\ \ repetitions_done INTEGER NOT NULL DEFAULT 0\ \)" - createVersionTable = - "CREATE TABLE version (\ - \ version_number INTEGER\ - \)" - fillVersionTable = - "INSERT INTO version (version_number) VALUES (?)" +-- createVersionTable = +-- "CREATE TABLE IF NOT EXISTS version (\ +-- \ version_number INTEGER PRIMARY KEY\ +-- \)" +-- fillVersionTable = +-- "INSERT INTO version (version_number) VALUES (?)" diff --git a/src/TaskMachine/DateExpr.hs b/src/TaskMachine/DateExpr.hs new file mode 100644 index 0000000..7be5944 --- /dev/null +++ b/src/TaskMachine/DateExpr.hs @@ -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 diff --git a/src/TaskMachine/Types.hs b/src/TaskMachine/Types.hs new file mode 100644 index 0000000..bd9a48a --- /dev/null +++ b/src/TaskMachine/Types.hs @@ -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" + } diff --git a/src/TaskMachine/UI.hs b/src/TaskMachine/UI.hs index d4af79d..ba746c2 100644 --- a/src/TaskMachine/UI.hs +++ b/src/TaskMachine/UI.hs @@ -1,24 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} -module TaskMachine.UI - ( defaultTheme - ) where +module TaskMachine.UI where import Data.Monoid -import qualified Brick as B -import qualified Brick.Themes as B -import qualified Graphics.Vty as VTY +import qualified Brick as B +import qualified Brick.Themes as B +import qualified Graphics.Vty as VTY + +import qualified TaskMachine.Types as TM defaultTheme :: B.Theme defaultTheme = B.newTheme VTY.defAttr - [ ("taskList" <> "normal", withStyle VTY.bold $ B.fg VTY.cyan) - , ("taskList" <> "highlight", withStyle VTY.bold $ 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) + [ ("taskList" <> "normal", withStyle VTY.bold $ B.fg VTY.cyan) + , ("taskList" <> "highlight", B.bg VTY.cyan) ] 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")