module Xrefcheck.System
( readingSystem
, askWithinCI
, RelGlobPattern (..)
, bindGlobPattern
) where
import Data.Aeson (FromJSON (..), withText)
import qualified Data.Char as C
import GHC.IO.Unsafe (unsafePerformIO)
import System.Directory (canonicalizePath)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import qualified System.FilePath.Glob as Glob
readingSystem :: IO a -> a
readingSystem = unsafePerformIO
askWithinCI :: IO Bool
askWithinCI = lookupEnv "CI" <&> \case
Just "1" -> True
Just (map C.toLower -> "true") -> True
_ -> False
newtype RelGlobPattern = RelGlobPattern FilePath
bindGlobPattern :: FilePath -> RelGlobPattern -> Glob.Pattern
bindGlobPattern root (RelGlobPattern relPat) = readingSystem $ do
absPat <- canonicalizePath (root </> relPat)
case Glob.tryCompileWith globCompileOptions absPat of
Left err ->
error $ "Glob pattern compilation failed after canonicalization: " <>
toText err
Right pat ->
return pat
instance FromJSON RelGlobPattern where
parseJSON = withText "Repo-relative glob pattern" $ \path -> do
let spath = toString path
_ <- Glob.tryCompileWith globCompileOptions spath
& either fail pure
return (RelGlobPattern spath)
globCompileOptions :: Glob.CompOptions
globCompileOptions = Glob.compDefault