Browse Source

Starting to switch to Cabal format

Getty Ritter 6 years ago
parent
commit
cf54b9a83b
5 changed files with 69 additions and 9 deletions
  1. 7 2
      hatch.cabal
  2. 27 3
      src/Config.hs
  3. 9 2
      src/Hatch.hs
  4. 9 2
      src/Types.hs
  5. 17 0
      src/Util.hs

+ 7 - 2
hatch.cabal

@@ -1,14 +1,16 @@
 name: hatch
-version: 0.1.0.0
+version: 0.1
 synopsis: A Haskell toolchain manager
+description:
+  The @hatch@ program allows for project-, user-, and system-level
+  switching between versions of GHC
 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
+cabal-version: >=2.0
 
 library
   hs-source-dirs: src
@@ -22,11 +24,13 @@ library
                , directory
                , filepath
                , unix
+               , Cabal
   default-language: Haskell2010
   default-extensions: ScopedTypeVariables
   exposed-modules: Hatch
   other-modules: Types
                  Config
+                 Util
 
 executable hatch
   hs-source-dirs: hatch

+ 27 - 3
src/Config.hs

@@ -3,7 +3,8 @@
 
 module Config
 ( ConfigFile
-, fetchConfig
+, readConfig
+, readProjectConfig
 , Ini.iniValueL
 ) where
 
@@ -13,22 +14,27 @@ 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
@@ -36,6 +42,7 @@ configSpec = do
                            & Ini.optional
     configCurrentCompiler .=? Ini.field "current" versionField
 
+
 versionField :: Ini.FieldValue Compiler
 versionField = Ini.FieldValue { .. }
   where
@@ -49,6 +56,7 @@ versionField = Ini.FieldValue { .. }
       | otherwise = Left ("Bad GHC version: " ++ show t)
     fvEmit = T.pack . compilerString
 
+
 locateConfig :: FilePath -> IO (Maybe FilePath)
 locateConfig filename = do
   xdgLocs <- Sys.getAllConfigFiles "hatch" filename
@@ -60,8 +68,23 @@ locateConfig filename = do
     []          -> return Nothing
     ((fp, _):_) -> return (Just fp)
 
-fetchConfig :: IO (Ini.Ini Config)
-fetchConfig = do
+
+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"
@@ -72,5 +95,6 @@ fetchConfig = do
       content <- T.readFile fp
       case Ini.parseIni content ini of
         Left err -> do
+          printErr err
           Sys.die err
         Right x -> return x

+ 9 - 2
src/Hatch.hs

@@ -2,7 +2,7 @@ module Hatch
 ( main
 ) where
 
-import           Lens.Family
+import           Lens.Family ((^.))
 import qualified System.Environment as Sys
 import           System.FilePath ((</>))
 import qualified System.FilePath as Sys
@@ -11,10 +11,11 @@ import qualified System.Posix.Process as Sys
 
 import Config
 import Types
+import Util
 
 main :: IO ()
 main = do
-  conf <- fetchConfig
+  conf <- readConfig
   print (conf^.iniValueL)
   programName <- Sys.takeFileName `fmap` Sys.getProgName
   if programName == "hatch"
@@ -36,6 +37,12 @@ runAsProxy conf program = do
       Sys.executeFile progn False args Nothing
 
 
+data HatchCommand
+  = SwitchCompiler
+  | FetchCompiler
+    deriving (Eq, Show)
+
 runAsHatch :: ConfigFile -> IO ()
 runAsHatch _ = do
+  printErr "testing"
   putStrLn "Invoking as Hatch!"

+ 9 - 2
src/Types.hs

@@ -1,8 +1,15 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
 
-module Types where
+module Types
+( Compiler(..)
+, compilerVersion
+, Config(..)
+, configInstallPath
+, configCurrentCompiler
+, compilerString
+) where
 
-import qualified Data.Text as T
 import qualified Lens.Family.TH as Lens
 
 data Compiler = Compiler

+ 17 - 0
src/Util.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Util
+( printErr
+) where
+
+import           Control.Monad (when)
+import qualified System.Posix.Terminal as Unix
+import qualified System.Posix.IO as Unix
+
+printErr :: String -> IO ()
+printErr msg = do
+  isTTY <- Unix.queryTerminal Unix.stdOutput
+  when isTTY $ putStr "\x1b[91m"
+  putStr msg
+  when isTTY $ putStr "\x1b[39m"
+  putStrLn ""