123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100 |
- {-# LANGUAGE OverloadedStrings #-}
- {-# LANGUAGE RecordWildCards #-}
- module Config
- ( ConfigFile
- , readConfig
- , readProjectConfig
- , Ini.iniValueL
- ) where
- import Control.Monad (forM)
- import Data.Ini.Config.Bidir ((.=), (.=?), (&))
- import qualified Data.Ini.Config.Bidir as Ini
- import qualified Data.Text as T
- import qualified Data.Text.IO as T
- import Data.Monoid ((<>))
- import qualified Distribution.ParseUtils as Cabal
- import qualified System.Directory as Sys
- import System.FilePath ((</>))
- import qualified System.FilePath as Sys
- import qualified System.Exit as Sys
- import qualified System.Environment.XDG.BaseDir as Sys
- import Text.Read (readMaybe)
- import Types
- import Util
- type ConfigFile = Ini.Ini Config
- defaultConfig :: IO Config
- defaultConfig = do
- _configInstallPath <- Sys.getUserDataDir ("hatch" </> "install")
- let _configCurrentCompiler = Nothing
- return Config { .. }
- configSpec :: Ini.IniSpec Config ()
- configSpec = do
- Ini.section "hatch" $ do
- configInstallPath .= Ini.field "path" Ini.string
- & Ini.optional
- configCurrentCompiler .=? Ini.field "current" versionField
- versionField :: Ini.FieldValue Compiler
- versionField = Ini.FieldValue { .. }
- where
- fvParse t
- | Just ver <- T.stripPrefix "ghc-" t
- , [x,y,z] <- T.splitOn "." ver
- , Just x' <- readMaybe (T.unpack x)
- , Just y' <- readMaybe (T.unpack y)
- , Just z' <- readMaybe (T.unpack z)
- = Right (Compiler (x', y', z'))
- | otherwise = Left ("Bad GHC version: " ++ show t)
- fvEmit = T.pack . compilerString
- locateConfig :: FilePath -> IO (Maybe FilePath)
- locateConfig filename = do
- xdgLocs <- Sys.getAllConfigFiles "hatch" filename
- let confLocations = ["./" <> filename] ++
- xdgLocs ++
- ["/etc/hatch/" <> filename]
- results <- forM confLocations (\fp -> (,) fp <$> Sys.doesFileExist fp)
- case filter snd results of
- [] -> return Nothing
- ((fp, _):_) -> return (Just fp)
- readProjectConfig :: IO ([Cabal.Field])
- readProjectConfig = Sys.getCurrentDirectory >>= go
- where go "/" = return []
- go path = do
- exists <- Sys.doesFileExist (path </> ".hatch")
- if exists
- then do
- content <- readFile (path </> ".hatch")
- case Cabal.readFields content of
- Cabal.ParseOk _ rs -> return rs
- _ -> return []
- else go (Sys.takeDirectory path)
- readConfig :: IO (Ini.Ini Config)
- readConfig = do
- def <- defaultConfig
- let ini = Ini.ini def configSpec
- confLocation <- locateConfig "config.ini"
- print confLocation
- case confLocation of
- Nothing -> return ini
- Just fp -> do
- content <- T.readFile fp
- case Ini.parseIni content ini of
- Left err -> do
- printErr err
- Sys.die err
- Right x -> return x
|