Make project compile again

This commit also adds a few other files that I've been working on,
although most of it will get deleted again. This is just so I have them
logged in git.

app/Main.hs

@@ -6,22 +6,22 @@ import           Control.Applicative
 import           Control.Exception
 import           Control.Monad
 import           Data.List
-import           Data.Maybe
+--import           Data.Maybe
 import           System.Exit
 import           System.IO.Error
 
 import qualified Brick.Themes           as B
 import qualified Data.ConfigFile        as C
-import qualified Data.Text              as T
+--import qualified Data.Text              as T
-import           Data.Time.Calendar
+--import           Data.Time.Calendar
-import           Data.Time.Clock
+--import           Data.Time.Clock
 import qualified Database.SQLite.Simple as DB
 import qualified Options.Applicative    as O
 import qualified System.Posix.User      as P
 
 import qualified TaskMachine.Config     as TM
-import qualified TaskMachine.Database   as TM
+--import qualified TaskMachine.Database   as TM
-import qualified TaskMachine.DateExpr   as TM
+--import qualified TaskMachine.DateExpr   as TM
 import qualified TaskMachine.UI         as TM
 
 -- TODO: When adding oConfigFile back, make oTaskDB a Maybe FilePath.
@@ -208,7 +208,7 @@ main = do
   -- ... and initialize db
   act $ "Using db at " ++ show (TM.cTaskDB config) ++ "."
   DB.withConnection (TM.cTaskDB config) $ \c -> do
-    TM.initializeNewDB c
+    --TM.initializeNewDB c
 
     -- TESTING
     testDB c
@@ -217,7 +217,8 @@ main = do
     error "Implement UI" theme config
 
 testDB :: DB.Connection -> IO ()
-testDB c = do
+testDB _ = do
+  {-
   now <- utctDay <$> getCurrentTime
   let deadlineBefore = Just $ addDays (-2) now
       deadlineAfter = Just $ addDays 2 now
@@ -242,3 +243,5 @@ testDB c = do
   putStrLn "RELEVANT TASKS"
   tasks2 <- TM.selectRelevantTasks c now
   forM_ tasks2 $ print . TM.rowDescription
+  -}
+  putStrLn "Everything works (because there's nothing here...)"

package.yaml

@@ -29,6 +29,7 @@ dependencies:
 - text
 - time
 - unix
+- vector
 - vty
 - hspec
 - QuickCheck

src/TaskMachine/Database.hs

@@ -1,10 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
-module TaskMachine.Database
+module TaskMachine.Database where
+{-
   ( TaskRow(..)
   , IntFormula(..)
   , BoolFormula(..)
+  , TaskID
+  , Duration
   , initializeNewDB
   , updateTasks
   , selectRelevantTasks
@@ -58,11 +61,12 @@ instance DB.FromField BoolFormula where
       Just expr -> DB.Ok BoolFormula{ boolFormulaText = text, boolFormulaExpr = expr }
 
 type TaskID = Integer
+type Duration = Integer
 
 data TaskRow = TaskRow
   { rowID               :: TaskID
   , rowDeadline         :: Maybe Day
-  , rowDuration         :: Integer -- If there is no deadline, the duration is irrelevant
+  , rowDuration         :: Maybe Integer -- If there is no deadline, duration is irrelevant
   , rowBoolFormula      :: Maybe BoolFormula -- Deadline formula
   , rowIntFormula       :: Maybe IntFormula  -- Info formula (e. g. age for birthdays)
   , rowDescription      :: T.Text
@@ -228,3 +232,4 @@ doTask c taskID = DB.execute c incrementTotal (DB.Only taskID)
       \  SET repetitions_done = repetitions_done + 1\
       \  WHERE id = ?\
       \    AND repetitions_done < repetitions_total"
+-}

src/TaskMachine/Task.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Task related stuff.
+--
+-- This module will be used by both the UI and the database modules.
+-- It contains some functionality independent of any of those modules.
+--
+-- (Although I don't really know what exactly that will be.)
+
+module TaskMachine.Task
+  ( Task(..)
+  , Subtask(..)
+  ) where
+
+import qualified Data.Text            as T
+
+import qualified TaskMachine.DateExpr as TM
+import qualified TaskMachine.Deadline as TM
+
+type SubtaskID = Integer
+
+data Subtask = Subtask
+  { subID               :: SubtaskID
+  , subLabel            :: T.Text
+  , subRepetitionsTotal :: Integer
+  , subRepetitionsDone  :: Integer
+  }
+
+type TaskID = Integer
+
+data Task = Task
+  { taskID          :: TaskID
+  , taskDeadlines   :: [TM.Deadline]
+  , taskFormula     :: Maybe TM.IntExpr
+  , taskDescription :: T.Text
+  , taskDetails     :: T.Text
+  , taskSubtasks    :: [Subtask]
+  }
+
+{-
+  ( Task(..)
+  , Deadline(..)
+  , fromTaskRow
+  , toTaskRow
+  ) where
+
+import qualified Data.Text            as T
+import           Data.Time.Calendar
+
+import qualified TaskMachine.Database as TM
+
+data Task = Task
+  { taskID               :: TM.TaskID
+  , taskDeadline         :: Deadline
+  , taskIntFormula       :: Maybe TM.IntFormula
+  , taskDescription      :: T.Text
+  , taskDetails          :: T.Text
+  , taskRepetitionsTotal :: Integer
+  , taskRepetitionsDone  :: Integer
+  }
+
+data Deadline
+  = DeadlineNone
+  | DeadlineDay Day (Maybe TM.Duration)
+  | DeadlineFormula TM.BoolFormula TM.Duration
+
+getDeadline :: TM.TaskRow -> Deadline
+getDeadline row = case TM.rowBoolFormula row of
+  Just formula -> DeadlineFormula formula $ fromMaybe 1 $ TM.rowDuration row
+  Nothing      -> case TM.rowDeadline row of
+    Just day -> DeadlineDay day $ TM.rowDuration row
+    Nothing  -> DeadlineNone
+
+fromTaskRow :: TM.TaskRow -> Task
+fromTaskRow row =
+  let taskID               = TM.rowID row
+      taskDeadline         = getDeadline row
+      taskIntFormula       = TM.rowIntFormula row
+      taskDescription      = TM.rowDescription row
+      taskDetails          = TM.rowDetails row
+      taskRepetitionsTotal = TM.rowRepetitionsTotal
+      taskRepetitionsDone  = TM.rowRepetitionsDone
+  in Task{..}
+
+toTaskRow :: Task -> TM.TaskRow
+toTaskRow task = undefined task
+
+nextDeadline :: Day -> Deadline -> Maybe Day
+updateDeadline (DeadlineFormula formula duration) =
+  let expr = boolFormulaExpr formula
+  in  Just $ TM.findNext expr day duration
+updateDeadline _ = Nothing
+-}

src/TaskMachine/UI.hs

@@ -6,9 +6,24 @@ import           Data.Monoid
 
 import qualified Brick                     as B
 import qualified Brick.Themes              as B
+import qualified Database.SQLite.Simple    as DB
 import qualified Graphics.Vty              as VTY
 
 import qualified TaskMachine.Config        as TM
+--import qualified TaskMachine.UI.ListScreen as TM
+
+data ResourceName = Asdf
+  deriving (Eq, Ord)
+
+data UIState = UIState
+  { uiConfig       :: TM.Config
+  , uiDBConnection :: DB.Connection
+  , uiScreenState  :: ScreenState
+  }
+
+data ScreenState
+  = Dummy
+--  = ScreenList TM.ListScreen
 
 defaultTheme :: B.Theme
 defaultTheme = B.newTheme VTY.defAttr
@@ -17,13 +32,6 @@ defaultTheme = B.newTheme VTY.defAttr
   ]
   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]

src/TaskMachine/UI/ListScreen.hs

@@ -0,0 +1,42 @@
+module TaskMachine.UI.ListScreen where
+{-
+  ( ListScreen
+  , newListScreen
+  , renderListScreen
+  , updateListScreen
+  ) where
+
+import qualified Brick                  as B
+import qualified Brick.Widgets.List     as B
+import           Data.Time
+import qualified Graphics.Vty.Input.Events as VTY
+import qualified Data.Vector            as V
+import qualified Database.SQLite.Simple as DB
+
+import qualified TaskMachine.Database   as TM
+import qualified TaskMachine.Task       as TM
+import qualified TaskMachine.UI.Types   as TM
+
+type Res = TM.ResourceName
+
+newtype ListScreen = ListScreen (B.List Res TM.Task)
+
+newListScreen :: DB.Connection -> IO ListScreen
+newListScreen conn = do
+  today <- utctDay <$> getCurrentTime
+  relevant <- map TM.fromTaskRow <$> TM.selectRelevantTasks conn today
+  let sorted = relevant -- TM.sort??? relevant
+      vector = V.fromList sorted
+      list   = B.list TM.RTaskList vector 1
+  return $ ListScreen list
+
+renderTask :: Bool -> TM.Task -> B.Widget Res
+renderTask _ task = B.txt $ TM.taskDescription task
+
+renderListScreen :: Bool -> ListScreen -> B.Widget Res
+renderListScreen focused (ListScreen list) = B.renderList renderTask focused list
+
+updateListScreen :: VTY.Event -> ListScreen -> B.EventM Res ListScreen
+updateListScreen event (ListScreen list) =
+  ListScreen <$> B.handleListEventVi B.handleListEvent event list
+-}

src/TaskMachine/UI/Types.hs

@@ -0,0 +1,7 @@
+module TaskMachine.UI.Types
+  ( ResourceName(..)
+  ) where
+
+data ResourceName
+  = RTaskList
+  deriving (Eq, Ord, Show)