hatch/src/Config.hs

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