Migrate from YAML to TOML (problematic!!)

The `tomland` library currently has some issues with Unicode characters,
which makes it not usable right now. In the future we could try to
migrate again but for now we should probably stick to YAML.

See kowainik/tomland#334

abbotsbury.cabal

@@ -89,7 +89,7 @@ executable abbot
     , microlens-platform
     , directory , filepath >=1.3.0.0 , process , time
     , exceptions , transformers , mtl
-    , yaml
+    , tomland
   ghc-options:
     -threaded
 

app/Commands/Open.hs

@@ -25,6 +25,9 @@ import           Data.Text                      ( Text )
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as TIO
 import           Data.Time.Clock                ( getCurrentTime )
+import           Data.Time.LocalTime            ( utc
+                                                , utcToLocalTime
+                                                )
 import           Lens.Micro.Platform
 import           System.Exit                    ( ExitCode(..) )
 import           System.Process                 ( proc
@@ -101,9 +104,10 @@ runOpen args input = do
       -- We don't ever want to throwError from within runOpen, because the last
       -- opened times of the refs always have to be updated, which we do here.
       currentTime <- liftIO getCurrentTime
-      let updatedRefnos = nub $ map fst successJobs
+      let localTime = utcToLocalTime utc currentTime  -- TOML only works with local times.
+          updatedRefnos = nub $ map fst successJobs
           updatedRefs   = foldl'
-            (\rs rno -> set (ix rno . timeOpened) currentTime rs)
+            (\rs rno -> set (ix rno . timeOpened) localTime rs)
             refs
             updatedRefnos
       -- Return the updated refs.

app/Main.hs

@@ -2,6 +2,10 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Main where
+import Data.Time.Clock
+import Data.Time.LocalTime
+import qualified Data.List.NonEmpty as NE hiding (length)
+import System.Directory (getCurrentDirectory)
 
 
 import           Abbotsbury

app/Path.hs

@@ -3,18 +3,28 @@ module Path
   , System.Directory.setCurrentDirectory
   ) where
 
+
 import           Reference
 
+
 import           Control.Monad.Except
 import           Data.IntMap                    ( IntMap )
 import qualified Data.IntMap                   as IM
 import           Data.List                      ( isInfixOf )
 import           Data.Text                      ( Text )
 import qualified Data.Text                     as T
-import           Data.Yaml
-import           Lens.Micro.Platform
+import           Lens.Micro.Platform            ( (^.) )
 import           System.Directory
 import           System.FilePath
+import           Data.Time.LocalTime            ( utc
+                                                , utcToLocalTime
+                                                , LocalTime
+                                                )
+import qualified Toml
+import           Toml                           ( (.=)
+                                                , TomlCodec
+                                                )
+
 
 -- | Expands relative paths and tildes in directories. Tilde expansion does not
 -- work with arbitrary users (`~user/path/to/file`), only the currently logged
@@ -34,59 +44,75 @@ expandDirectory fp =
       )
         >>= canonicalizePath
 
+
 -- | The file name where abbotsbury stores its information. In theory this
 -- could be customisable, but in practice I can't be bothered.
-yamlFileName :: FilePath
-yamlFileName = "abbot.yaml"
-
--- | My own set of YAML errors, which is meant to make error reporting less
--- complicated, as we don't need the full set of ParseExceptions.
-data MyYamlError = YamlFileNotFound
-                 | InvalidYamlInFile
-                 | OtherYamlError
-
--- | Simplify the full set of ParseExceptions into MyYamlError.
-categoriseYamlError :: ParseException -> MyYamlError
-categoriseYamlError (InvalidYaml (Just (YamlException excText)))
-  | "Yaml file not found" `isInfixOf` excText = YamlFileNotFound
-  | "mapping values are not allowed" `isInfixOf` excText = InvalidYamlInFile
-  | otherwise = OtherYamlError
-categoriseYamlError (AesonException _) = InvalidYamlInFile
-categoriseYamlError _                  = OtherYamlError
-
--- | Reads in a list of references from the YAML file in a folder, but
+tomlFileName :: FilePath
+tomlFileName = "abbot.toml"
+
+
+authorCodec :: TomlCodec Author
+authorCodec = Author <$> Toml.dioptional (Toml.text "given") .= _given
+                     <*> Toml.text "family" .= _family
+
+
+workCodec :: TomlCodec Work
+workCodec = Work <$> Toml.enumBounded "workType" .= _workType
+                 <*> Toml.text "title" .= _title
+                 <*> Toml.nonEmpty authorCodec "authors" .= _authors
+                 <*> Toml.text "journalLong" .= _journalLong
+                 <*> Toml.text "journalShort" .= _journalShort
+                 <*> Toml.int "year" .= _year
+                 <*> Toml.text "volume" .= _volume
+                 <*> Toml.text "issue" .= _issue
+                 <*> Toml.text "pages" .= _pages
+                 <*> Toml.text "doi" .= _doi
+                 <*> Toml.text "articleNumber" .= _articleNumber
+
+
+referenceCodec :: TomlCodec Reference
+referenceCodec = Reference <$> Toml.table workCodec "work" .= _work
+                           <*> Toml.list (Toml.text "tag") "tags" .= _tags
+                           <*> Toml.localTime "timeAdded" .= _timeAdded
+                           <*> Toml.localTime "timeOpened" .= _timeOpened
+
+
+referenceListCodec :: TomlCodec [Reference]
+referenceListCodec = Toml.list referenceCodec "reference"
+
+
+-- | Reads in a list of references from the TOML file in a folder, but
 -- also does some pattern matching on the returned result so that error
 -- messages are easier to deal with in the main loop.
 readRefs :: FilePath -> ExceptT Text IO (IntMap Reference)
 readRefs cwd = do
-  let fname = cwd </> yamlFileName
-      invalidYamlErrMsg =
-        "The file "
-          <> T.pack fname
-          <> " was found, but it does not "
-          <> "contain articles in the correct "
-          <> "format for abbotsbury."
-  refs <- liftIO $ decodeFileEither fname
+  let fname = cwd </> tomlFileName
+  -- Check if the file exists. This might not be best practice (race conditions...)
+  tomlFileExists <- liftIO $ doesFileExist fname
+  unless tomlFileExists (throwError "abbot.toml file not found")
+  -- Read the file contents
+  refs <- liftIO $ Toml.decodeFileExact referenceListCodec fname
   case refs of
     -- Successfully parsed.
     Right newRefs  -> pure (IM.fromList $ zip [1..] newRefs)
     -- Some error
-    Left  parseExc -> case categoriseYamlError parseExc of
-      YamlFileNotFound  -> pure IM.empty
-      InvalidYamlInFile -> throwError invalidYamlErrMsg
-      OtherYamlError    -> throwError $ T.pack
-        (show parseExc <> "\n This error is unexpected; please file a bug!")
+    Left  parseExcs -> throwError $ Toml.prettyTomlDecodeErrors parseExcs
+
 
 -- | Saves a list of references to the given FilePath, as long as it's not empty.
 -- This prevents us from creating files which didn't exist in the first place.
 saveRefs :: IntMap Reference -> FilePath -> IO ()
-saveRefs refs cwd = unless (IM.null refs)
-                           (encodeFile (cwd </> yamlFileName) (IM.elems refs))
+saveRefs refs cwd = unless (IM.null refs) $ do
+  let refList = IM.elems refs
+      tomlFile = cwd </> tomlFileName
+  void $ Toml.encodeToFile referenceListCodec tomlFile refList
+
 
 data PDFType = FullText
              | SI
              deriving (Ord, Eq, Show)
 
+
 -- | Find the path to a PDF file belonging to a reference.
 getPDFPath :: PDFType    -- Full text or SI.
            -> FilePath   -- Current working directory.

app/Reference.hs

@@ -9,7 +9,7 @@ module Reference
 import           Abbotsbury.Work
 import           Data.Aeson
 import           Data.Text                      ( Text )
-import           Data.Time.Clock
+import           Data.Time.LocalTime
 import           GHC.Generics
 import           Lens.Micro.Platform
 
@@ -18,8 +18,8 @@ type Tag = Text
 data Reference = Reference
   { _work       :: Work
   , _tags       :: [Tag]
-  , _timeAdded  :: UTCTime
-  , _timeOpened :: UTCTime
+  , _timeAdded  :: LocalTime
+  , _timeOpened :: LocalTime
   }
   deriving (Generic, Show)
 

data/abbot.toml

@@ -0,0 +1,78 @@
+
+[[reference]]
+  timeAdded = 2021-05-09 00:10:25.231913
+  timeOpened = 2021-05-09 00:10:25.231913
+
+  [reference.work]
+    articleNumber = ""
+    doi = "10.1021/acs.orglett.9b00971"
+    issue = "8"
+    journalLong = "Organic Letters"
+    journalShort = "Org. Lett."
+    pages = "2918-2922"
+    title = "A General Copper-Catalyzed Synthesis of Ynamides from 1,2-Dichloroenamides"
+    volume = "21"
+    workType = "JournalArticle"
+    year = 2019
+
+    [[reference.work.authors]]
+      family = "Mansfield"
+      given = "Steven J."
+
+    [[reference.work.authors]]
+      family = "Smith"
+      given = "Russell C."
+
+    [[reference.work.authors]]
+      family = "Yong"
+      given = "Jonathan R. J."
+
+    [[reference.work.authors]]
+      family = "Garry"
+      given = "Olivia L."
+
+    [[reference.work.authors]]
+      family = "Anderson"
+      given = "Edward A."
+
+  [[reference.tags]]
+    tag = "nmr"
+
+  [[reference.tags]]
+    tag = "hello"
+
+[[reference]]
+  timeAdded = 2021-05-09 00:10:25.231913
+  timeOpened = 2021-05-09 00:10:25.231913
+
+  [reference.work]
+    articleNumber = "27"
+    doi = "10.1038/s43586-021-00024-3"
+    issue = "1"
+    journalLong = "Nature Reviews Methods Primers"
+    journalShort = "Nat. Rev. Methods Primers"
+    pages = ""
+    title = "Parallel nuclear magnetic resonance spectroscopy"
+    volume = "1"
+    workType = "JournalArticle"
+    year = 2021
+
+    [[reference.work.authors]]
+      family = "Kup\\U0000010de"
+      given = "\\U00000112riks"
+
+    [[reference.work.authors]]
+      family = "Frydman"
+      given = "Lucio"
+
+    [[reference.work.authors]]
+      family = "Webb"
+      given = "Andrew G."
+
+    [[reference.work.authors]]
+      family = "Yong"
+      given = "Jonathan R. J."
+
+    [[reference.work.authors]]
+      family = "Claridge"
+      given = "Tim D. W."

src/Abbotsbury/Work.hs

@@ -21,7 +21,7 @@ data WorkType = BookSection | Monograph | Report | PeerReview | BookTrack
               | BookChapter | ProceedingsSeries | ReportSeries | Proceedings
               | Standard | ReferenceBook | PostedContent | JournalIssue
               | Dissertation | Dataset | BookSeries | EditedBook | StandardSeries
-              deriving (Generic, Eq, Show)
+              deriving (Generic, Eq, Show, Enum, Bounded)
 
 
 -- | TODO: Add more fields here.