Simplify loading stuff and use home directory more

app/Main.hs

@@ -13,7 +13,7 @@ import qualified Brick.Themes           as B
 import qualified Data.ConfigFile        as C
 import qualified Database.SQLite.Simple as DB
 import qualified Options.Applicative    as O
-import qualified System.Posix.User as P
+import qualified System.Posix.User      as P
 
 import qualified TaskMachine.Config     as TM
 import qualified TaskMachine.Database   as TM
@@ -39,20 +39,6 @@ data Options = Options
 noConfigFile :: ExitCode
 noConfigFile = ExitFailure 10
 
-rethrowAs :: (Exception e, Exception f) => (e -> Maybe f) -> IO a -> IO a
-rethrowAs f action = do
-  res <- tryJust f action
-  case res of
-    Right v -> return v
-    Left e  -> throwIO e
-
-rethrowAsIf :: (Exception e, Exception f) => (e -> Bool) -> f -> IO a -> IO a
-rethrowAsIf check newException action = do
-  res <- tryJust (guard . check) action
-  case res of
-    Right v -> return v
-    Left _ -> throwIO newException
-
 {-
  - Useful functions
  -}
@@ -79,7 +65,7 @@ argParser homedir = pure Options
       , O.help $ "Where to look for a config file.\
                  \ This option can be set multiple times.\
                  \ If not specified, will look in these locations:\n"
-                 ++ (intercalate "," $ map show $ TM.defaultConfigFilePaths homedir)
+                 ++ intercalate "," (map show $ TM.defaultConfigFilePaths homedir)
       , O.metavar "CONFIGFILE"
       ]
     taskDB = O.strOption $ mconcat
@@ -121,29 +107,24 @@ argParserInfo homedir = O.info (O.helper <*> argParser homedir) $ mconcat
  -}
 
 -- Kinda ugly...
-loadConfigs :: [FilePath] -> IO (Maybe TM.Config)
-loadConfigs [] = return Nothing
-loadConfigs (path:paths) = do
+loadConfigs :: TM.HomeDir -> [FilePath] -> IO (Maybe TM.Config)
+loadConfigs _ [] = return Nothing
+loadConfigs homedir (path:paths) = do
   act $ "Loading config from " ++ show path ++ "."
-  mConf <- tryLoadConfig path
+  mConf <- handleOpenFileExceptions $ tryLoadConfig path
   case mConf of
     Just conf -> return (Just conf)
     Nothing -> do
       putStrLn $ "Could not load config from " ++ show path ++ "."
-      loadConfigs paths
+      loadConfigs homedir paths
   where
     tryLoadConfig :: FilePath -> IO (Maybe TM.Config)
-    tryLoadConfig p = handleOpenFileExceptions
-                    $ handleCPException
-                    $ Just <$> TM.loadConfig p
-    --tryLoadConfig p = Just <$> TM.loadConfig p
-    handleCPException :: IO (Maybe a) -> IO (Maybe a)
-    handleCPException f = do
-      res <- try f
-      case res of
-        Right m                                  -> return m
-        Left (TM.CPException (C.ParseError msg)) -> Nothing <$ putStrLn msg
-        Left (TM.CPException _                 ) -> putStrLn "Bleep" >> return Nothing
+    tryLoadConfig p = do
+      eConf <- TM.loadConfig homedir p
+      case eConf of
+        Right conf              -> return $ Just conf
+        Left (C.ParseError msg) -> Nothing <$ putStrLn msg
+        Left _                  -> return Nothing
     handleOpenFileExceptions :: IO (Maybe a) -> IO (Maybe a)
     handleOpenFileExceptions f = do
       res <- tryJust (guard . isRelevantError) f
@@ -170,7 +151,7 @@ loadThemes :: B.Theme -> [FilePath] -> IO B.Theme
 loadThemes theme [] = return theme
 loadThemes theme (path:paths) = do
   act $ "Loading theme from " ++ show path ++ "."
-  mNewTheme <- tryLoadCustomizations path theme
+  mNewTheme <- handleOpenFileExceptions $ B.loadCustomizations path theme
   case mNewTheme of
     Nothing -> do
       putStrLn $ "Could not load theme from " ++ show path ++ "."
@@ -180,14 +161,11 @@ loadThemes theme (path:paths) = do
       putStrLn $ "Could not load theme from " ++ show path ++ ": " ++ errMsg
       loadThemes theme paths
   where
-    tryLoadCustomizations :: FilePath -> B.Theme -> IO (Maybe (Either String B.Theme))
-    tryLoadCustomizations p t = handleOpenFileExceptions
-                              $ Just <$> B.loadCustomizations p t
-    handleOpenFileExceptions :: IO (Maybe a) -> IO (Maybe a)
+    handleOpenFileExceptions :: IO a -> IO (Maybe a)
     handleOpenFileExceptions f = do
       res <- tryJust (guard . isRelevantError) f
       case res of
-        Right m -> return m
+        Right m -> return $ Just m
         Left _  -> return Nothing
     isRelevantError :: IOError -> Bool
     isRelevantError e =  isAlreadyInUseError e
@@ -202,7 +180,7 @@ main = do
   -- Export default config
   forM_ (oExportDefaultConfig options) $ \path -> do
     act $ "Exporting default config to " ++ show path ++ "."
-    TM.saveConfig path TM.defaultConfig
+    TM.saveConfig path $ TM.defaultConfig homedir
 
   -- Export default theme
   forM_ (oExportDefaultTheme options) $ \path -> do
@@ -210,7 +188,7 @@ main = do
     B.saveTheme path TM.defaultTheme
 
   -- Load config
-  mConfig <- loadConfigs $ oConfigFile options
+  mConfig <- loadConfigs homedir $ oConfigFile options
   config <- case mConfig of
     Nothing -> do
       putStrLn ""
@@ -219,31 +197,12 @@ main = do
       exitWith noConfigFile
     Just unmergedConfig -> return $ mergeWithOptions unmergedConfig options
 
-  -- According to config, load themes and initialize db
+  -- According to config, load themes
   theme <- loadThemes TM.defaultTheme $ TM.cThemes config
+
+  -- ... and initialize db
+  act $ "Using db at " ++ show (TM.cTaskDB config) ++ "."
   DB.withConnection (TM.cTaskDB config) TM.initializeNewDB
 
   -- Start the UI
   error "Implement UI" theme config
-
---import qualified Database.SQLite.Simple as DB
---import qualified TaskMachine.Database as TMD
---main = DB.withConnection "test.db" TMD.initializeNewDB
-
---data ResourceName = Asdf
---  deriving (Eq, Ord)
---
---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 TM.defaultTheme
---  }
---  where
---    myTestWidget = normal B.<=> urgent B.<=> veryUrgent B.<=> overdue
---    normal     = B.withAttr ("taskList"                 <> "normal") (B.str "     normal ") B.<+> B.withAttr ("taskList"                 <> "highlight") (B.str "style")
---    urgent     = B.withAttr ("taskList" <> "urgent"     <> "normal") (B.str "     urgent ") B.<+> B.withAttr ("taskList" <> "urgent"     <> "highlight") (B.str "style")
---    veryUrgent = B.withAttr ("taskList" <> "veryUrgent" <> "normal") (B.str "very urgent ") B.<+> B.withAttr ("taskList" <> "veryUrgent" <> "highlight") (B.str "style")
---    overdue    = B.withAttr ("taskList" <> "overdue"    <> "normal") (B.str "    overdue ") B.<+> B.withAttr ("taskList" <> "overdue"    <> "highlight") (B.str "style")