gdritter repos hatch / master
Starting to switch to Cabal format Getty Ritter 6 years ago
5 changed file(s) with 69 addition(s) and 10 deletion(s). Collapse all Expand all
11 name: hatch
2 version: 0.1.0.0
2 version: 0.1
33 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
57 license: BSD3
68 author: Getty Ritter <hatch@infinitenegativeutility.com>
79 maintainer: Getty Ritter <hatch@infinitenegativeutility.com>
810 copyright: @2018 Getty Ritter
911 category: Build
1012 build-type: Simple
11 cabal-version: >=1.14
13 cabal-version: >=2.0
1214
1315 library
1416 hs-source-dirs: src
2224 , directory
2325 , filepath
2426 , unix
27 , Cabal
2528 default-language: Haskell2010
2629 default-extensions: ScopedTypeVariables
2730 exposed-modules: Hatch
2831 other-modules: Types
2932 Config
33 Util
3034
3135 executable hatch
3236 hs-source-dirs: hatch
33
44 module Config
55 ( ConfigFile
6 , fetchConfig
6 , readConfig
7 , readProjectConfig
78 , Ini.iniValueL
89 ) where
910
1314 import qualified Data.Text as T
1415 import qualified Data.Text.IO as T
1516 import Data.Monoid ((<>))
17 import qualified Distribution.ParseUtils as Cabal
1618 import qualified System.Directory as Sys
1719 import System.FilePath ((</>))
20 import qualified System.FilePath as Sys
1821 import qualified System.Exit as Sys
1922 import qualified System.Environment.XDG.BaseDir as Sys
2023 import Text.Read (readMaybe)
2124
2225 import Types
26 import Util
2327
2428 type ConfigFile = Ini.Ini Config
29
2530
2631 defaultConfig :: IO Config
2732 defaultConfig = do
2934 let _configCurrentCompiler = Nothing
3035 return Config { .. }
3136
37
3238 configSpec :: Ini.IniSpec Config ()
3339 configSpec = do
3440 Ini.section "hatch" $ do
3541 configInstallPath .= Ini.field "path" Ini.string
3642 & Ini.optional
3743 configCurrentCompiler .=? Ini.field "current" versionField
44
3845
3946 versionField :: Ini.FieldValue Compiler
4047 versionField = Ini.FieldValue { .. }
4956 | otherwise = Left ("Bad GHC version: " ++ show t)
5057 fvEmit = T.pack . compilerString
5158
59
5260 locateConfig :: FilePath -> IO (Maybe FilePath)
5361 locateConfig filename = do
5462 xdgLocs <- Sys.getAllConfigFiles "hatch" filename
6068 [] -> return Nothing
6169 ((fp, _):_) -> return (Just fp)
6270
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
6588 def <- defaultConfig
6689 let ini = Ini.ini def configSpec
6790 confLocation <- locateConfig "config.ini"
7295 content <- T.readFile fp
7396 case Ini.parseIni content ini of
7497 Left err -> do
98 printErr err
7599 Sys.die err
76100 Right x -> return x
22 ( main
33 ) where
44
5 import Lens.Family
5 import Lens.Family ((^.))
66 import qualified System.Environment as Sys
77 import System.FilePath ((</>))
88 import qualified System.FilePath as Sys
1111
1212 import Config
1313 import Types
14 import Util
1415
1516 main :: IO ()
1617 main = do
17 conf <- fetchConfig
18 conf <- readConfig
1819 print (conf^.iniValueL)
1920 programName <- Sys.takeFileName `fmap` Sys.getProgName
2021 if programName == "hatch"
3637 Sys.executeFile progn False args Nothing
3738
3839
40 data HatchCommand
41 = SwitchCompiler
42 | FetchCompiler
43 deriving (Eq, Show)
44
3945 runAsHatch :: ConfigFile -> IO ()
4046 runAsHatch _ = do
47 printErr "testing"
4148 putStrLn "Invoking as Hatch!"
11 {-# LANGUAGE TemplateHaskell #-}
2 {-# OPTIONS_GHC -Wno-missing-signatures #-}
23
3 module Types where
4 module Types
5 ( Compiler(..)
6 , compilerVersion
7 , Config(..)
8 , configInstallPath
9 , configCurrentCompiler
10 , compilerString
11 ) where
412
5 import qualified Data.Text as T
613 import qualified Lens.Family.TH as Lens
714
815 data Compiler = Compiler
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 ""