Commit df48db235440519ac90547da152c70f536b60202 - hatch

+20

-0

.gitignore less more

	1	dist
	2	dist-*
	3	*~
	4	cabal-dev
	5	*.o
	6	*.hi
	7	*.chi
	8	*.chs.h
	9	*.dyn_o
	10	*.dyn_hi
	11	.hpc
	12	.hsenv
	13	.cabal-sandbox/
	14	cabal.sandbox.config
	15	*.prof
	16	*.aux
	17	*.hp
	18	*.eventlog
	19	cabal.project.local
	20	.ghc.environment.*

+6

-0

hatch/Main.hs less more

	1	module Main where
	2
	3	import qualified Hatch
	4
	5	main :: IO ()
	6	main = Hatch.main

+38

-0

hatch.cabal less more

	1	name: hatch
	2	version: 0.1.0.0
	3	synopsis: A Haskell toolchain manager
	4	-- description:
	5	license: BSD3
	6	author: Getty Ritter <hatch@infinitenegativeutility.com>
	7	maintainer: Getty Ritter <hatch@infinitenegativeutility.com>
	8	copyright: @2018 Getty Ritter
	9	category: Build
	10	build-type: Simple
	11	cabal-version: >=1.14
	12
	13	library
	14	hs-source-dirs: src
	15	ghc-options: -Wall
	16	build-depends: base >=4.7 && <5
	17	, config-ini
	18	, lens-family-core
	19	, lens-family-th
	20	, text
	21	, xdg-basedir
	22	, directory
	23	, filepath
	24	, unix
	25	default-language: Haskell2010
	26	default-extensions: ScopedTypeVariables
	27	exposed-modules: Hatch
	28	other-modules: Types
	29	Config
	30
	31	executable hatch
	32	hs-source-dirs: hatch
	33	main-is: Main.hs
	34	default-language: Haskell2010
	35	default-extensions: ScopedTypeVariables
	36	ghc-options: -Wall
	37	build-depends: base >=4.7 && <5
	38	, hatch

+76

-0

src/Config.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2	{-# LANGUAGE RecordWildCards #-}
	3
	4	module Config
	5	( ConfigFile
	6	, fetchConfig
	7	, Ini.iniValueL
	8	) where
	9
	10	import Control.Monad (forM)
	11	import Data.Ini.Config.Bidir ((.=), (.=?), (&))
	12	import qualified Data.Ini.Config.Bidir as Ini
	13	import qualified Data.Text as T
	14	import qualified Data.Text.IO as T
	15	import Data.Monoid ((<>))
	16	import qualified System.Directory as Sys
	17	import System.FilePath ((</>))
	18	import qualified System.Exit as Sys
	19	import qualified System.Environment.XDG.BaseDir as Sys
	20	import Text.Read (readMaybe)
	21
	22	import Types
	23
	24	type ConfigFile = Ini.Ini Config
	25
	26	defaultConfig :: IO Config
	27	defaultConfig = do
	28	_configInstallPath <- Sys.getUserDataDir ("hatch" </> "install")
	29	let _configCurrentCompiler = Nothing
	30	return Config { .. }
	31
	32	configSpec :: Ini.IniSpec Config ()
	33	configSpec = do
	34	Ini.section "hatch" $ do
	35	configInstallPath .= Ini.field "path" Ini.string
	36	& Ini.optional
	37	configCurrentCompiler .=? Ini.field "current" versionField
	38
	39	versionField :: Ini.FieldValue Compiler
	40	versionField = Ini.FieldValue { .. }
	41	where
	42	fvParse t
	43	\| Just ver <- T.stripPrefix "ghc-" t
	44	, [x,y,z] <- T.splitOn "." ver
	45	, Just x' <- readMaybe (T.unpack x)
	46	, Just y' <- readMaybe (T.unpack y)
	47	, Just z' <- readMaybe (T.unpack z)
	48	= Right (Compiler (x', y', z'))
	49	\| otherwise = Left ("Bad GHC version: " ++ show t)
	50	fvEmit = T.pack . compilerString
	51
	52	locateConfig :: FilePath -> IO (Maybe FilePath)
	53	locateConfig filename = do
	54	xdgLocs <- Sys.getAllConfigFiles "hatch" filename
	55	let confLocations = ["./" <> filename] ++
	56	xdgLocs ++
	57	["/etc/hatch/" <> filename]
	58	results <- forM confLocations (\fp -> (,) fp <$> Sys.doesFileExist fp)
	59	case filter snd results of
	60	[] -> return Nothing
	61	((fp, _):_) -> return (Just fp)
	62
	63	fetchConfig :: IO (Ini.Ini Config)
	64	fetchConfig = do
	65	def <- defaultConfig
	66	let ini = Ini.ini def configSpec
	67	confLocation <- locateConfig "config.ini"
	68	print confLocation
	69	case confLocation of
	70	Nothing -> return ini
	71	Just fp -> do
	72	content <- T.readFile fp
	73	case Ini.parseIni content ini of
	74	Left err -> do
	75	Sys.die err
	76	Right x -> return x

+41

-0

src/Hatch.hs less more

	1	module Hatch
	2	( main
	3	) where
	4
	5	import Lens.Family
	6	import qualified System.Environment as Sys
	7	import System.FilePath ((</>))
	8	import qualified System.FilePath as Sys
	9	import qualified System.Exit as Sys
	10	import qualified System.Posix.Process as Sys
	11
	12	import Config
	13	import Types
	14
	15	main :: IO ()
	16	main = do
	17	conf <- fetchConfig
	18	print (conf^.iniValueL)
	19	programName <- Sys.takeFileName `fmap` Sys.getProgName
	20	if programName == "hatch"
	21	then runAsHatch conf
	22	else runAsProxy conf programName
	23
	24
	25	runAsProxy :: ConfigFile -> FilePath -> IO ()
	26	runAsProxy conf program = do
	27	putStrLn ("Invoking as " ++ program)
	28	let ver = conf^.iniValueL.configCurrentCompiler
	29	case ver of
	30	Nothing -> Sys.die "No compiler configured!"
	31	Just c -> do
	32	let ver' = compilerString c
	33	root = conf^.iniValueL.configInstallPath </> ver'
	34	progn = root </> "bin" </> program
	35	args <- Sys.getArgs
	36	Sys.executeFile progn False args Nothing
	37
	38
	39	runAsHatch :: ConfigFile -> IO ()
	40	runAsHatch _ = do
	41	putStrLn "Invoking as Hatch!"

+22

-0

src/Types.hs less more

	1	{-# LANGUAGE TemplateHaskell #-}
	2
	3	module Types where
	4
	5	import qualified Data.Text as T
	6	import qualified Lens.Family.TH as Lens
	7
	8	data Compiler = Compiler
	9	{ _compilerVersion :: (Int, Int, Int)
	10	} deriving (Eq, Show)
	11
	12	data Config = Config
	13	{ _configInstallPath :: FilePath
	14	, _configCurrentCompiler :: Maybe Compiler
	15	} deriving (Eq, Show)
	16
	17	Lens.makeLenses ''Compiler
	18	Lens.makeLenses ''Config
	19
	20	compilerString :: Compiler -> String
	21	compilerString (Compiler (x, y, z)) =
	22	"ghc-" ++ show x ++ "." ++ show y ++ "." ++ show z