Commit cf54b9a83bc33b60305e8f341ecb508baec9888e - hatch

+7

-3

hatch.cabal less more

1	1	name: hatch
2		version: 0.1~~.0.0~~
	2	version: 0.1
3	3	synopsis: A Haskell toolchain manager
4		-- description:
	4	description:
	5	The @hatch@ program allows for project-, user-, and system-level
	6	switching between versions of GHC
5	7	license: BSD3
6	8	author: Getty Ritter <hatch@infinitenegativeutility.com>
7	9	maintainer: Getty Ritter <hatch@infinitenegativeutility.com>
8	10	copyright: @2018 Getty Ritter
9	11	category: Build
10	12	build-type: Simple
11		cabal-version: >=~~1.14~~
	13	cabal-version: >=2.0
12	14
13	15	library
14	16	hs-source-dirs: src

22	24	, directory
23	25	, filepath
24	26	, unix
	27	, Cabal
25	28	default-language: Haskell2010
26	29	default-extensions: ScopedTypeVariables
27	30	exposed-modules: Hatch
28	31	other-modules: Types
29	32	Config
	33	Util
30	34
31	35	executable hatch
32	36	hs-source-dirs: hatch

+27

-3

src/Config.hs less more

3	3
4	4	module Config
5	5	( ConfigFile
6		, ~~fetch~~Config
	6	, readConfig
	7	, readProjectConfig
7	8	, Ini.iniValueL
8	9	) where
9	10

13	14	import qualified Data.Text as T
14	15	import qualified Data.Text.IO as T
15	16	import Data.Monoid ((<>))
	17	import qualified Distribution.ParseUtils as Cabal
16	18	import qualified System.Directory as Sys
17	19	import System.FilePath ((</>))
	20	import qualified System.FilePath as Sys
18	21	import qualified System.Exit as Sys
19	22	import qualified System.Environment.XDG.BaseDir as Sys
20	23	import Text.Read (readMaybe)
21	24
22	25	import Types
	26	import Util
23	27
24	28	type ConfigFile = Ini.Ini Config
	29
25	30
26	31	defaultConfig :: IO Config
27	32	defaultConfig = do

29	34	let _configCurrentCompiler = Nothing
30	35	return Config { .. }
31	36
	37
32	38	configSpec :: Ini.IniSpec Config ()
33	39	configSpec = do
34	40	Ini.section "hatch" $ do
35	41	configInstallPath .= Ini.field "path" Ini.string
36	42	& Ini.optional
37	43	configCurrentCompiler .=? Ini.field "current" versionField
	44
38	45
39	46	versionField :: Ini.FieldValue Compiler
40	47	versionField = Ini.FieldValue { .. }

49	56	\| otherwise = Left ("Bad GHC version: " ++ show t)
50	57	fvEmit = T.pack . compilerString
51	58
	59
52	60	locateConfig :: FilePath -> IO (Maybe FilePath)
53	61	locateConfig filename = do
54	62	xdgLocs <- Sys.getAllConfigFiles "hatch" filename

60	68	[] -> return Nothing
61	69	((fp, _):_) -> return (Just fp)
62	70
63		fetchConfig :: IO (Ini.Ini Config)
64		fetchConfig = do
	71
	72	readProjectConfig :: IO ([Cabal.Field])
	73	readProjectConfig = Sys.getCurrentDirectory >>= go
	74	where go "/" = return []
	75	go path = do
	76	exists <- Sys.doesFileExist (path </> ".hatch")
	77	if exists
	78	then do
	79	content <- readFile (path </> ".hatch")
	80	case Cabal.readFields content of
	81	Cabal.ParseOk _ rs -> return rs
	82	_ -> return []
	83	else go (Sys.takeDirectory path)
	84
	85
	86	readConfig :: IO (Ini.Ini Config)
	87	readConfig = do
65	88	def <- defaultConfig
66	89	let ini = Ini.ini def configSpec
67	90	confLocation <- locateConfig "config.ini"

72	95	content <- T.readFile fp
73	96	case Ini.parseIni content ini of
74	97	Left err -> do
	98	printErr err
75	99	Sys.die err
76	100	Right x -> return x

+9

-2

src/Hatch.hs less more

2	2	( main
3	3	) where
4	4
5		import Lens.Family
	5	import Lens.Family ((^.))
6	6	import qualified System.Environment as Sys
7	7	import System.FilePath ((</>))
8	8	import qualified System.FilePath as Sys

11	11
12	12	import Config
13	13	import Types
	14	import Util
14	15
15	16	main :: IO ()
16	17	main = do
17		conf <- ~~fetch~~Config
	18	conf <- readConfig
18	19	print (conf^.iniValueL)
19	20	programName <- Sys.takeFileName `fmap` Sys.getProgName
20	21	if programName == "hatch"

36	37	Sys.executeFile progn False args Nothing
37	38
38	39
	40	data HatchCommand
	41	= SwitchCompiler
	42	\| FetchCompiler
	43	deriving (Eq, Show)
	44
39	45	runAsHatch :: ConfigFile -> IO ()
40	46	runAsHatch _ = do
	47	printErr "testing"
41	48	putStrLn "Invoking as Hatch!"

+9

-2

src/Types.hs less more

1	1	{-# LANGUAGE TemplateHaskell #-}
	2	{-# OPTIONS_GHC -Wno-missing-signatures #-}
2	3
3		module Types ~~where~~
	4	module Types
	5	( Compiler(..)
	6	, compilerVersion
	7	, Config(..)
	8	, configInstallPath
	9	, configCurrentCompiler
	10	, compilerString
	11	) where
4	12
5		import qualified Data.Text as T
6	13	import qualified Lens.Family.TH as Lens
7	14
8	15	data Compiler = Compiler

+17

-0

src/Util.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2
	3	module Util
	4	( printErr
	5	) where
	6
	7	import Control.Monad (when)
	8	import qualified System.Posix.Terminal as Unix
	9	import qualified System.Posix.IO as Unix
	10
	11	printErr :: String -> IO ()
	12	printErr msg = do
	13	isTTY <- Unix.queryTerminal Unix.stdOutput
	14	when isTTY $ putStr "\x1b[91m"
	15	putStr msg
	16	when isTTY $ putStr "\x1b[39m"
	17	putStrLn ""