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

View file

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

View file

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

View file

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

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 #-} {-# 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")