Try out several things

This commit is contained in:
Joscha 2018-03-19 18:39:15 +00:00
parent 5e1555511d
commit 163d08cf79
7 changed files with 173 additions and 54 deletions

View file

@ -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

View file

@ -21,6 +21,8 @@ description: Please see the README on Github at <https://github.com/Garm
dependencies:
- base >= 4.7 && < 5
- text
- time
- sqlite-simple
- brick
- vty

View file

@ -1,6 +0,0 @@
module Lib
( someFunc
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"

View file

@ -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 (?)"

View 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
View 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"
}

View file

@ -1,8 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
module TaskMachine.UI
( defaultTheme
) where
module TaskMachine.UI where
import Data.Monoid
@ -10,15 +8,29 @@ 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" <> "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")