{- SPDX-FileCopyrightText: 2018-2019 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Xrefcheck.Config where

import Control.Lens (makeLensesWith)
import Data.Aeson.TH (deriveFromJSON)
import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withText)
import Instances.TH.Lift ()
import Text.Regex.TDFA (CompOption (..), ExecOption (..), Regex)
import Text.Regex.TDFA.Text (compile)

import Data.FileEmbed (embedFile)
-- FIXME: Use </> from System.FilePath
-- </> from Posix is used only because we cross-compile to Windows and \ doesn't work on Linux
import System.FilePath.Posix ((</>))
import Time (KnownRatName, Second, Time, unitsP)

import Xrefcheck.System (RelGlobPattern)
import Xrefcheck.Util (aesonConfigOption, postfixFields)

-- | Overall config.
data Config = Config
    { Config -> TraversalConfig
cTraversal    :: TraversalConfig
    , Config -> VerifyConfig
cVerification :: VerifyConfig
    }

-- | Config of repositry traversal.
data TraversalConfig = TraversalConfig
    { TraversalConfig -> [FilePath]
tcIgnored   :: [FilePath]
      -- ^ Files and folders, files in which we completely ignore.
    }

-- | Config of verification.
data VerifyConfig = VerifyConfig
    { VerifyConfig -> Double
vcAnchorSimilarityThreshold :: Double
    , VerifyConfig -> Time Second
vcExternalRefCheckTimeout   :: Time Second
    , VerifyConfig -> [RelGlobPattern]
vcVirtualFiles              :: [RelGlobPattern]
      -- ^ Files which we pretend do exist.
    , VerifyConfig -> [FilePath]
vcNotScanned                :: [FilePath]
      -- ^ Prefixes of files, references in which we should not analyze.
    , VerifyConfig -> Maybe [Regex]
vcIgnoreRefs                :: Maybe [Regex]
      -- ^ Regular expressions that match external references we should not verify.
    }

makeLensesWith postfixFields ''Config
makeLensesWith postfixFields ''VerifyConfig

-----------------------------------------------------------
-- Default config
-----------------------------------------------------------

-- | Default config in textual representation.
--
-- Sometimes you cannot just use 'defConfig' because clarifying comments
-- would be lost.
defConfigText :: ByteString
defConfigText :: ByteString
defConfigText =
  $(embedFile ("src-files" </> "def-config.yaml"))

defConfig :: HasCallStack => Config
defConfig :: Config
defConfig =
  (ParseException -> Config)
-> (Config -> Config) -> Either ParseException Config -> Config
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Config
forall a. HasCallStack => Text -> a
error (Text -> Config)
-> (ParseException -> Text) -> ParseException -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (ParseException -> FilePath) -> ParseException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> FilePath
prettyPrintParseException) Config -> Config
forall a. a -> a
id (Either ParseException Config -> Config)
-> Either ParseException Config -> Config
forall a b. (a -> b) -> a -> b
$
  ByteString -> Either ParseException Config
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' ByteString
defConfigText

-----------------------------------------------------------
-- Yaml instances
-----------------------------------------------------------

deriveFromJSON aesonConfigOption ''Config
deriveFromJSON aesonConfigOption ''TraversalConfig
deriveFromJSON aesonConfigOption ''VerifyConfig

instance KnownRatName unit => FromJSON (Time unit) where
    parseJSON :: Value -> Parser (Time unit)
parseJSON = FilePath
-> (Text -> Parser (Time unit)) -> Value -> Parser (Time unit)
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
withText FilePath
"time" ((Text -> Parser (Time unit)) -> Value -> Parser (Time unit))
-> (Text -> Parser (Time unit)) -> Value -> Parser (Time unit)
forall a b. (a -> b) -> a -> b
$
        Parser (Time unit)
-> (Time unit -> Parser (Time unit))
-> Maybe (Time unit)
-> Parser (Time unit)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Parser (Time unit)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Unknown time") Time unit -> Parser (Time unit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Time unit) -> Parser (Time unit))
-> (Text -> Maybe (Time unit)) -> Text -> Parser (Time unit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe (Time unit)
forall (unit :: Rat).
KnownRatName unit =>
FilePath -> Maybe (Time unit)
unitsP (FilePath -> Maybe (Time unit))
-> (Text -> FilePath) -> Text -> Maybe (Time unit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString

instance FromJSON Regex where
    parseJSON :: Value -> Parser Regex
parseJSON = FilePath -> (Text -> Parser Regex) -> Value -> Parser Regex
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
withText FilePath
"regex" ((Text -> Parser Regex) -> Value -> Parser Regex)
-> (Text -> Parser Regex) -> Value -> Parser Regex
forall a b. (a -> b) -> a -> b
$ \Text
val -> do
        let errOrRegex :: Either FilePath Regex
errOrRegex =
                CompOption -> ExecOption -> Text -> Either FilePath Regex
compile CompOption
defaultCompOption ExecOption
defaultExecOption Text
val
        (FilePath -> Parser Regex)
-> (Regex -> Parser Regex) -> Either FilePath Regex -> Parser Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Parser Regex
forall a. HasCallStack => Text -> a
error (Text -> Parser Regex)
-> (FilePath -> Text) -> FilePath -> Parser Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall b a. (Show a, IsString b) => a -> b
show) Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Either FilePath Regex
errOrRegex

-- Default boolean values according to
-- https://hackage.haskell.org/package/regex-tdfa-1.3.1.0/docs/Text-Regex-TDFA.html#t:CompOption
defaultCompOption :: CompOption
defaultCompOption :: CompOption
defaultCompOption =
    CompOption :: Bool -> Bool -> Bool -> Bool -> Bool -> CompOption
CompOption
    { caseSensitive :: Bool
caseSensitive = Bool
True
    , multiline :: Bool
multiline = Bool
True
    , rightAssoc :: Bool
rightAssoc = Bool
True
    , newSyntax :: Bool
newSyntax = Bool
True
    , lastStarGreedy :: Bool
lastStarGreedy = Bool
False
    }

-- ExecOption value to improve speed
defaultExecOption :: ExecOption
defaultExecOption :: ExecOption
defaultExecOption = ExecOption :: Bool -> ExecOption
ExecOption {captureGroups :: Bool
captureGroups = Bool
False}