{-# 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