ff new --vcs (#171)

CHANGELOG.md

@@ -17,6 +17,7 @@ and this project adheres to
 - `Note.links` field
 - Load notes once for searching tasks and wikis
 - `(ff agenda | ff search) --without-tag=...` to filter notes without specific tag
+- Do not use git repo as a database if there is no .ff yet. And use it when `ff new --vcs ...`
 
 ## [0.13] - 2019-09-10
 ### Added

ff-core/lib/FF.hs

@@ -19,6 +19,7 @@ module FF
     cmdPostpone,
     cmdSearch,
     cmdUnarchive,
+    directoryConflict,
     fromRga,
     fromRgaM,
     getContactSamples,
@@ -33,12 +34,14 @@ module FF
     loadAllNotes,
     loadTagsByRefs,
     noDataDirectoryMessage,
+    noVcs,
     splitModes,
     sponsors,
     takeSamples,
     updateTrackedNotes,
     viewNote,
     viewNoteSample,
+    DataDirectory(..),
   )
 where
 
@@ -621,24 +624,43 @@ assertNoteIsNative = do
       $ "A tracked note must be edited in its source"
         <> maybe "" (" :" <>) track_url
 
-getDataDir :: Config -> IO (Maybe FilePath)
+getDataDir :: Config -> IO DataDirectory
 getDataDir Config {dataDir} = do
   cur <- getCurrentDirectory
-  mDataDirFromVcs <- findVcs $ parents cur
-  pure $ mDataDirFromVcs <|> dataDir
+  findVcs $ parents cur
   where
     parents = reverse . scanl1 (</>) . splitDirectories . normalise
-    findVcs [] = pure Nothing
+    findVcs [] = pure $ DataDirectory Nothing dataDir
     findVcs (dir : dirs) = do
-      isDirVcs <- doesDirectoryExist (dir </> ".git")
-      if isDirVcs
-        then pure . Just $ dir </> ".ff"
-        else findVcs dirs
+      isDirVcsGit <- doesDirectoryExist (dir </> ".git")
+      isDirFF <- doesDirectoryExist (dir </> ".ff")
+      getDataDirectory isDirVcsGit isDirFF
+      where
+        getDataDirectory isDirVcsGit isDirFF
+          | isDirVcsGit && isDirFF =
+              pure $ DataDirectory {vcsNeed = Nothing, vcsNotNeed = Just $ dir </> ".ff"}
+          | not isDirVcsGit && isDirFF =
+              pure $ DataDirectory {vcsNeed = Nothing, vcsNotNeed = Just $ dir </> ".ff"}
+          | isDirVcsGit && not isDirFF =
+              pure $ DataDirectory {vcsNeed = Just $ dir </> ".ff", vcsNotNeed = dataDir}
+          | otherwise = findVcs dirs
+
+data DataDirectory = DataDirectory
+  { vcsNeed :: Maybe FilePath -- ^ new .ff path next to .git directory when vcs needed
+  , vcsNotNeed :: Maybe FilePath -- ^ existing .ff path when vcs not needed
+  }
 
 noDataDirectoryMessage :: String
 noDataDirectoryMessage =
   "Data directory isn't set, run `ff config dataDir --help`"
 
+noVcs :: String
+noVcs = "You set '--vcs', but there is no directory containing .git repo"
+
+directoryConflict :: String
+directoryConflict =
+  "You set custom directory and vcs directory. Choose one argument, please."
+
 whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
 whenJust m f = case m of
   Nothing -> pure ()

ff-core/lib/FF/CLI.hs

@@ -42,17 +42,20 @@ import FF
     cmdPostpone,
     cmdSearch,
     cmdUnarchive,
+    directoryConflict,
     getContactSamples,
     getDataDir,
     getUtcToday,
     loadAllNotes,
     loadAllTagTexts,
     noDataDirectoryMessage,
+    noVcs,
     sponsors,
     updateTrackedNotes,
     viewNote,
     viewTaskSamples,
     viewWikiSamples,
+    DataDirectory(..),
   )
 import FF.Config
   ( Config (..),
@@ -104,19 +107,27 @@ import System.Pager (printOrPage)
 cli :: Version -> IO ()
 cli version = do
   cfg@Config {ui} <- loadConfig
-  dataDir <- getDataDir cfg
-  handle' <- traverse StorageFS.newHandle dataDir
+  DataDirectory{vcsNeed, vcsNotNeed} <- getDataDir cfg
+  handle' <- traverse StorageFS.newHandle vcsNotNeed
   Options {brief, customDir, cmd} <- parseOptions handle'
-  handle <-
-    case customDir of
-      Nothing -> pure handle'
-      Just path -> Just <$> StorageFS.newHandle path
+  let getHandle mPath = case mPath of
+        Nothing -> pure handle'
+        Just path -> Just <$> StorageFS.newHandle path
   case cmd of
     CmdConfig param -> runCmdConfig cfg param
     CmdVersion -> runCmdVersion version
-    CmdAction action -> case handle of
-      Nothing -> fail noDataDirectoryMessage
-      Just h -> runStorage h $ runCmdAction ui action brief
+    CmdAction action -> case (action,customDir)  of
+      (CmdNew Options.New{vcs = True}, Nothing) -> do
+        handle <- getHandle vcsNeed
+        case handle of
+          Nothing -> fail noVcs
+          Just h -> runStorage h $ runCmdAction ui action brief
+      (CmdNew Options.New{vcs = True}, Just _) -> fail directoryConflict
+      (_, customDir') -> do
+        handle <- getHandle customDir'
+        case handle of
+          Nothing -> fail noDataDirectoryMessage
+          Just h -> runStorage h $ runCmdAction ui action brief
 
 runCmdConfig :: Config -> Maybe Options.Config -> IO ()
 runCmdConfig cfg@Config {dataDir, ui} = \case

ff-core/lib/FF/Options.hs

@@ -152,7 +152,8 @@ data New
         start :: Maybe Day,
         end :: Maybe Day,
         isWiki :: Bool,
-        tags :: Set Text
+        tags :: Set Text,
+        vcs :: Bool
       }
 
 data Search
@@ -242,6 +243,7 @@ parser h =
     cmdUpgrade = pure CmdUpgrade
     cmdWiki = CmdWiki <$> optional limitOption
     wiki = switch $ long "wiki" <> short 'w' <> help "Handle wiki note"
+    vcsOption = switch $ long "vcs" <> help "Create '.ff' for data next to .git directory"
     briefOption =
       switch $ long "brief" <> short 'b' <> help "List only note titles and ids"
     agenda = Agenda <$> optional limitOption <*> filterTags <*> withoutTagsOption
@@ -277,6 +279,7 @@ parser h =
         <*> optional endDateOption
         <*> wiki
         <*> addTagsOption
+        <*> vcsOption
     edit =
       Edit
         <$> some1 noteid

ff-gtk/Main.hs

@@ -26,6 +26,7 @@ import FF
     loadAllNotes,
     noDataDirectoryMessage,
     viewNote,
+    DataDirectory(..),
   )
 import FF.Config (loadConfig)
 import FF.Types
@@ -140,7 +141,7 @@ initiallyLoadActiveTasks storage = do
 getDataDirOrFail :: IO FilePath
 getDataDirOrFail = do
   cfg <- loadConfig
-  dataDir <- getDataDir cfg
-  case dataDir of
+  DataDirectory {vcsNotNeed}  <- getDataDir cfg
+  case vcsNotNeed of
     Nothing -> fail noDataDirectoryMessage
     Just path -> pure path

ff-qt/Main.hs

@@ -29,6 +29,7 @@ import FF
     loadAllNotes,
     noDataDirectoryMessage,
     viewNote,
+    DataDirectory(..),
   )
 import FF.Config (loadConfig)
 import FF.Types
@@ -113,8 +114,8 @@ main = do
 getDataDirOrFail :: IO FilePath
 getDataDirOrFail = do
   cfg <- loadConfig
-  dataDir <- getDataDir cfg
-  case dataDir of
+  DataDirectory {vcsNotNeed} <- getDataDir cfg
+  case vcsNotNeed of
     Nothing -> fail noDataDirectoryMessage
     Just path -> pure path
 

ff-test/test/Database.hs

@@ -210,7 +210,7 @@ prop_new =
    in property $ do
         (note, fs') <-
           evalEither $ runStorageSim mempty
-            $ cmdNewNote New {text, start, end, isWiki = False, tags} today
+            $ cmdNewNote New {text, start, end, isWiki = False, tags, vcs = False} today
         let tags' =
               mapMaybe UUID.decodeBase32
                 ["B000000001NDU-2000000000012", "B000000004HKM-2000000000012"]