{-# 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)
import System.FilePath.Posix ((</>))
import Time (KnownRatName, Second, Time, unitsP)
import Xrefcheck.System (RelGlobPattern)
import Xrefcheck.Util (aesonConfigOption, postfixFields)
data Config = Config
{ Config -> TraversalConfig
cTraversal :: TraversalConfig
, Config -> VerifyConfig
cVerification :: VerifyConfig
}
data TraversalConfig = TraversalConfig
{ TraversalConfig -> [FilePath]
tcIgnored :: [FilePath]
}
data VerifyConfig = VerifyConfig
{ VerifyConfig -> Double
vcAnchorSimilarityThreshold :: Double
, VerifyConfig -> Time Second
vcExternalRefCheckTimeout :: Time Second
, VerifyConfig -> [RelGlobPattern]
vcVirtualFiles :: [RelGlobPattern]
, VerifyConfig -> [FilePath]
vcNotScanned :: [FilePath]
, VerifyConfig -> Maybe [Regex]
vcIgnoreRefs :: Maybe [Regex]
}
makeLensesWith postfixFields ''Config
makeLensesWith postfixFields ''VerifyConfig
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
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
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
}
defaultExecOption :: ExecOption
defaultExecOption :: ExecOption
defaultExecOption = ExecOption :: Bool -> ExecOption
ExecOption {captureGroups :: Bool
captureGroups = Bool
False}