1 files changed, 92 insertions, 0 deletions
diff --git a/app/Settings.hs b/app/Settings.hs
new file mode 100644
index 0000000..5d4d55f
--- /dev/null
+++ b/app/Settings.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Settings
+  ( Settings (..),
+    readSettings,
+    writeSettings,
+    SuggestedTag (..),
+  )
+where
+
+import Data.Aeson qualified as A
+import Data.Function (on)
+import Data.List (nub)
+import Data.Text qualified as T
+import Data.Yaml (decodeFileThrow, encodeFile)
+import GHC.Generics (Generic)
+import System.Directory (doesFileExist)
+import System.Environment.XDG.BaseDir (getSystemConfigFiles, getUserConfigFile)
+import Text.RE.TDFA.Text qualified as R
+
+data Settings = Settings
+  { suggestedTags :: [SuggestedTag]
+  }
+  deriving (Show, Generic)
+
+instance Semigroup Settings where
+  a <> b =
+    Settings
+      { suggestedTags = nub (a.suggestedTags <> b.suggestedTags)
+      }
+
+instance Monoid Settings where
+  mempty =
+    Settings
+      { suggestedTags =
+          [ -- TODO Add `SuggestedTagByDate`
+            --
+            -- By having a dedicated constructor for dates wie can take the following improvements into account:
+            --
+            -- -   date formats that spell out the month name, ie. `1 Januar 1970` or `1 Jan 1970`
+            -- -   perform minor corrections on OCR, ie. parse `0 1.01.1970`
+            SuggestTagByRE "createdAt" [R.re|[0-9]{2}\.[0-9]{2}\.[0-9]{4}|]
+          ]
+      }
+
+instance A.FromJSON Settings
+
+instance A.ToJSON Settings
+
+data SuggestedTag
+  = SuggestTagByRE T.Text R.RE
+  deriving (Show, Generic, Eq)
+
+instance Show R.RE where
+  show = R.reSource
+
+instance Eq R.RE where
+  (==) = (==) `on` show
+
+instance A.FromJSON SuggestedTag
+
+instance A.ToJSON SuggestedTag
+
+instance A.FromJSON R.RE where
+  parseJSON = A.withText "regular expression (POSIX)" (R.compileRegex . T.unpack)
+
+instance A.ToJSON R.RE where
+  toJSON = A.toJSON . R.reSource
+
+readSettings :: IO Settings
+readSettings =
+  fmap mconcat
+    . mapM
+      ( \fp ->
+          doesFileExist fp >>= \case
+            True -> decodeFileThrow fp
+            False -> pure mempty
+      )
+    =<< concat
+      <$> sequence
+        [ getSystemConfigFiles "apaperless" "settings.yaml",
+          ((: []) <$> getUserConfigFile "apaperless" "settings.yaml"),
+          pure ["apaperless.yaml"]
+        ]
+
+writeSettings :: FilePath -> Settings -> IO ()
+writeSettings =
+  encodeFile