Stubbd-out config parsing and executable proxying

.gitignore

@@ -0,0 +1,20 @@
+dist
+dist-*
+*~
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+cabal.project.local
+.ghc.environment.*

hatch.cabal

@@ -0,0 +1,38 @@
+name: hatch
+version: 0.1.0.0
+synopsis: A Haskell toolchain manager
+-- description:
+license: BSD3
+author: Getty Ritter <hatch@infinitenegativeutility.com>
+maintainer: Getty Ritter <hatch@infinitenegativeutility.com>
+copyright: @2018 Getty Ritter
+category: Build
+build-type: Simple
+cabal-version: >=1.14
+
+library
+  hs-source-dirs: src
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5
+               , config-ini
+               , lens-family-core
+               , lens-family-th
+               , text
+               , xdg-basedir
+               , directory
+               , filepath
+               , unix
+  default-language: Haskell2010
+  default-extensions: ScopedTypeVariables
+  exposed-modules: Hatch
+  other-modules: Types
+                 Config
+
+executable hatch
+  hs-source-dirs: hatch
+  main-is: Main.hs
+  default-language: Haskell2010
+  default-extensions: ScopedTypeVariables
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5
+               , hatch

hatch/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import qualified Hatch
+
+main :: IO ()
+main = Hatch.main

src/Config.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Config
+( ConfigFile
+, fetchConfig
+, 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 System.Directory as Sys
+import           System.FilePath ((</>))
+import qualified System.Exit as Sys
+import qualified System.Environment.XDG.BaseDir as Sys
+import           Text.Read (readMaybe)
+
+import           Types
+
+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)
+
+fetchConfig :: IO (Ini.Ini Config)
+fetchConfig = 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
+          Sys.die err
+        Right x -> return x

src/Hatch.hs

@@ -0,0 +1,41 @@
+module Hatch
+( main
+) where
+
+import           Lens.Family
+import qualified System.Environment as Sys
+import           System.FilePath ((</>))
+import qualified System.FilePath as Sys
+import qualified System.Exit as Sys
+import qualified System.Posix.Process as Sys
+
+import Config
+import Types
+
+main :: IO ()
+main = do
+  conf <- fetchConfig
+  print (conf^.iniValueL)
+  programName <- Sys.takeFileName `fmap` Sys.getProgName
+  if programName == "hatch"
+    then runAsHatch conf
+    else runAsProxy conf programName
+
+
+runAsProxy :: ConfigFile -> FilePath -> IO ()
+runAsProxy conf program = do
+  putStrLn ("Invoking as " ++ program)
+  let ver = conf^.iniValueL.configCurrentCompiler
+  case ver of
+    Nothing -> Sys.die "No compiler configured!"
+    Just c -> do
+      let ver' = compilerString c
+          root = conf^.iniValueL.configInstallPath </> ver'
+          progn = root </> "bin" </> program
+      args <- Sys.getArgs
+      Sys.executeFile progn False args Nothing
+
+
+runAsHatch :: ConfigFile -> IO ()
+runAsHatch _ = do
+  putStrLn "Invoking as Hatch!"

src/Types.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Types where
+
+import qualified Data.Text as T
+import qualified Lens.Family.TH as Lens
+
+data Compiler = Compiler
+  { _compilerVersion :: (Int, Int, Int)
+  } deriving (Eq, Show)
+
+data Config = Config
+  { _configInstallPath     :: FilePath
+  , _configCurrentCompiler :: Maybe Compiler
+  } deriving (Eq, Show)
+
+Lens.makeLenses ''Compiler
+Lens.makeLenses ''Config
+
+compilerString :: Compiler -> String
+compilerString (Compiler (x, y, z)) =
+  "ghc-" ++ show x ++ "." ++ show y ++ "." ++ show z