Fix HLS support and compile errors with boot and TH files
This commit is contained in:
		
							parent
							
								
									5c026591cb
								
							
						
					
					
						commit
						6073ebe476
					
				@ -17,7 +17,6 @@ import           GHCup.OptParse.Common
 | 
			
		||||
import           GHCup
 | 
			
		||||
import           GHCup.Errors
 | 
			
		||||
import           GHCup.Types
 | 
			
		||||
import           GHCup.Utils.File
 | 
			
		||||
import           GHCup.Utils.Logger
 | 
			
		||||
import           GHCup.Utils.String.QQ
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -65,6 +65,7 @@ library
 | 
			
		||||
    GHCup.Requirements
 | 
			
		||||
    GHCup.Types
 | 
			
		||||
    GHCup.Types.JSON
 | 
			
		||||
    GHCup.Types.JSON.Utils
 | 
			
		||||
    GHCup.Types.Optics
 | 
			
		||||
    GHCup.Utils
 | 
			
		||||
    GHCup.Utils.Dirs
 | 
			
		||||
 | 
			
		||||
@ -6,6 +6,7 @@
 | 
			
		||||
{-# LANGUAGE OverloadedStrings #-}
 | 
			
		||||
{-# LANGUAGE FlexibleContexts  #-}
 | 
			
		||||
{-# LANGUAGE FlexibleInstances #-}
 | 
			
		||||
{-# LANGUAGE TemplateHaskell   #-}
 | 
			
		||||
{-# LANGUAGE DuplicateRecordFields #-}
 | 
			
		||||
 | 
			
		||||
{-|
 | 
			
		||||
@ -30,12 +31,15 @@ import           Data.Map.Strict                ( Map )
 | 
			
		||||
import           Data.List.NonEmpty             ( NonEmpty (..) )
 | 
			
		||||
import           Data.Text                      ( Text )
 | 
			
		||||
import           Data.Versions
 | 
			
		||||
import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
 | 
			
		||||
import           GHC.IO.Exception               ( ExitCode )
 | 
			
		||||
import           Optics                         ( makeLenses )
 | 
			
		||||
import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text, (<+>))
 | 
			
		||||
import           URI.ByteString
 | 
			
		||||
#if defined(BRICK)
 | 
			
		||||
import           Graphics.Vty                   ( Key(..) )
 | 
			
		||||
#endif
 | 
			
		||||
 | 
			
		||||
import qualified Data.ByteString.Lazy          as BL
 | 
			
		||||
import qualified Data.Text                     as T
 | 
			
		||||
import qualified GHC.Generics                  as GHC
 | 
			
		||||
 | 
			
		||||
@ -600,3 +604,27 @@ data LoggerConfig = LoggerConfig
 | 
			
		||||
 | 
			
		||||
instance NFData LoggerConfig where
 | 
			
		||||
  rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
 | 
			
		||||
 | 
			
		||||
data ProcessError = NonZeroExit Int FilePath [String]
 | 
			
		||||
                  | PTerminated FilePath [String]
 | 
			
		||||
                  | PStopped FilePath [String]
 | 
			
		||||
                  | NoSuchPid FilePath [String]
 | 
			
		||||
                  deriving Show
 | 
			
		||||
 | 
			
		||||
instance Pretty ProcessError where
 | 
			
		||||
  pPrint (NonZeroExit e exe args) =
 | 
			
		||||
    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
 | 
			
		||||
  pPrint (PTerminated exe args) =
 | 
			
		||||
    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
 | 
			
		||||
  pPrint (PStopped exe args) =
 | 
			
		||||
    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
 | 
			
		||||
  pPrint (NoSuchPid exe args) =
 | 
			
		||||
    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
 | 
			
		||||
data CapturedProcess = CapturedProcess
 | 
			
		||||
  { _exitCode :: ExitCode
 | 
			
		||||
  , _stdOut   :: BL.ByteString
 | 
			
		||||
  , _stdErr   :: BL.ByteString
 | 
			
		||||
  }
 | 
			
		||||
  deriving (Eq, Show)
 | 
			
		||||
 | 
			
		||||
makeLenses ''CapturedProcess
 | 
			
		||||
 | 
			
		||||
@ -22,10 +22,8 @@ Portability : portable
 | 
			
		||||
module GHCup.Types.JSON where
 | 
			
		||||
 | 
			
		||||
import           GHCup.Types
 | 
			
		||||
import           GHCup.Types.JSON.Utils
 | 
			
		||||
import           GHCup.Utils.MegaParsec
 | 
			
		||||
import           GHCup.Utils.Prelude
 | 
			
		||||
import           GHCup.Utils.Logger             () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
 | 
			
		||||
                                                   -- This is due to the boot file.
 | 
			
		||||
 | 
			
		||||
import           Control.Applicative            ( (<|>) )
 | 
			
		||||
import           Data.Aeson              hiding (Key)
 | 
			
		||||
@ -40,6 +38,7 @@ import           Text.Casing
 | 
			
		||||
 | 
			
		||||
import qualified Data.List.NonEmpty            as NE
 | 
			
		||||
import qualified Data.Text                     as T
 | 
			
		||||
import qualified Data.Text.Encoding.Error      as E
 | 
			
		||||
import qualified Text.Megaparsec               as MP
 | 
			
		||||
import qualified Text.Megaparsec.Char          as MPC
 | 
			
		||||
 | 
			
		||||
@ -78,7 +77,7 @@ instance FromJSON Tag where
 | 
			
		||||
    x -> pure (UnknownTag x)
 | 
			
		||||
 | 
			
		||||
instance ToJSON URI where
 | 
			
		||||
  toJSON = toJSON . decUTF8Safe . serializeURIRef'
 | 
			
		||||
  toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
 | 
			
		||||
 | 
			
		||||
instance FromJSON URI where
 | 
			
		||||
  parseJSON = withText "URL" $ \t ->
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										17
									
								
								lib/GHCup/Types/JSON/Utils.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										17
									
								
								lib/GHCup/Types/JSON/Utils.hs
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,17 @@
 | 
			
		||||
{-|
 | 
			
		||||
Module      : GHCup.Types.JSON.Utils
 | 
			
		||||
Description : Utils for TH splices
 | 
			
		||||
Copyright   : (c) Julian Ospald, 2020
 | 
			
		||||
License     : LGPL-3.0
 | 
			
		||||
Maintainer  : hasufell@hasufell.de
 | 
			
		||||
Stability   : experimental
 | 
			
		||||
Portability : portable
 | 
			
		||||
-}
 | 
			
		||||
 | 
			
		||||
module GHCup.Types.JSON.Utils where
 | 
			
		||||
 | 
			
		||||
import qualified Data.Text                     as T
 | 
			
		||||
 | 
			
		||||
removeLensFieldLabel :: String -> String
 | 
			
		||||
removeLensFieldLabel str' =
 | 
			
		||||
  maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
 | 
			
		||||
@ -3,7 +3,6 @@
 | 
			
		||||
{-# LANGUAGE FlexibleContexts      #-}
 | 
			
		||||
{-# LANGUAGE OverloadedStrings     #-}
 | 
			
		||||
{-# LANGUAGE QuasiQuotes           #-}
 | 
			
		||||
{-# LANGUAGE TemplateHaskellQuotes #-}
 | 
			
		||||
{-# LANGUAGE TypeApplications      #-}
 | 
			
		||||
{-# LANGUAGE ViewPatterns          #-}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -1,11 +1,15 @@
 | 
			
		||||
{-# LANGUAGE OverloadedStrings #-}
 | 
			
		||||
{-# LANGUAGE FlexibleContexts  #-}
 | 
			
		||||
{-# LANGUAGE TemplateHaskell   #-}
 | 
			
		||||
{-# LANGUAGE ViewPatterns      #-}
 | 
			
		||||
 | 
			
		||||
module GHCup.Utils.File.Common where
 | 
			
		||||
module GHCup.Utils.File.Common (
 | 
			
		||||
  module GHCup.Utils.File.Common
 | 
			
		||||
  , ProcessError(..)
 | 
			
		||||
  , CapturedProcess(..)
 | 
			
		||||
  ) where
 | 
			
		||||
 | 
			
		||||
import           GHCup.Utils.Prelude
 | 
			
		||||
import           GHCup.Types(ProcessError(..), CapturedProcess(..))
 | 
			
		||||
 | 
			
		||||
import           Control.Monad.Reader
 | 
			
		||||
import           Data.Maybe
 | 
			
		||||
@ -24,33 +28,6 @@ import qualified Text.Megaparsec               as MP
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
data ProcessError = NonZeroExit Int FilePath [String]
 | 
			
		||||
                  | PTerminated FilePath [String]
 | 
			
		||||
                  | PStopped FilePath [String]
 | 
			
		||||
                  | NoSuchPid FilePath [String]
 | 
			
		||||
                  deriving Show
 | 
			
		||||
 | 
			
		||||
instance Pretty ProcessError where
 | 
			
		||||
  pPrint (NonZeroExit e exe args) =
 | 
			
		||||
    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
 | 
			
		||||
  pPrint (PTerminated exe args) =
 | 
			
		||||
    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
 | 
			
		||||
  pPrint (PStopped exe args) =
 | 
			
		||||
    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
 | 
			
		||||
  pPrint (NoSuchPid exe args) =
 | 
			
		||||
    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
 | 
			
		||||
 | 
			
		||||
data CapturedProcess = CapturedProcess
 | 
			
		||||
  { _exitCode :: ExitCode
 | 
			
		||||
  , _stdOut   :: BL.ByteString
 | 
			
		||||
  , _stdErr   :: BL.ByteString
 | 
			
		||||
  }
 | 
			
		||||
  deriving (Eq, Show)
 | 
			
		||||
 | 
			
		||||
makeLenses ''CapturedProcess
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
-- | Search for a file in the search paths.
 | 
			
		||||
--
 | 
			
		||||
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
 | 
			
		||||
 | 
			
		||||
@ -1,5 +1,4 @@
 | 
			
		||||
{-# LANGUAGE FlexibleContexts #-}
 | 
			
		||||
{-# LANGUAGE QuasiQuotes      #-}
 | 
			
		||||
{-# LANGUAGE DataKinds        #-}
 | 
			
		||||
{-# LANGUAGE OverloadedStrings   #-}
 | 
			
		||||
 | 
			
		||||
@ -18,7 +17,7 @@ module GHCup.Utils.Logger where
 | 
			
		||||
 | 
			
		||||
import           GHCup.Types
 | 
			
		||||
import           GHCup.Types.Optics
 | 
			
		||||
import {-# SOURCE #-} GHCup.Utils.File.Common
 | 
			
		||||
import {-# SOURCE #-} GHCup.Utils.File.Common (findFiles)
 | 
			
		||||
import           GHCup.Utils.String.QQ
 | 
			
		||||
 | 
			
		||||
import           Control.Exception.Safe
 | 
			
		||||
 | 
			
		||||
@ -1,7 +1,5 @@
 | 
			
		||||
{-# LANGUAGE FlexibleContexts #-}
 | 
			
		||||
{-# LANGUAGE QuasiQuotes      #-}
 | 
			
		||||
{-# LANGUAGE DataKinds        #-}
 | 
			
		||||
{-# LANGUAGE OverloadedStrings   #-}
 | 
			
		||||
 | 
			
		||||
module GHCup.Utils.Logger where
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -30,7 +30,7 @@ where
 | 
			
		||||
import           GHCup.Types
 | 
			
		||||
import           GHCup.Errors
 | 
			
		||||
import           GHCup.Types.Optics
 | 
			
		||||
import {-# SOURCE #-} GHCup.Utils.Logger
 | 
			
		||||
import {-# SOURCE #-} GHCup.Utils.Logger (logWarn)
 | 
			
		||||
#if defined(IS_WINDOWS)
 | 
			
		||||
import           GHCup.Utils.Prelude.Windows
 | 
			
		||||
#else
 | 
			
		||||
@ -308,11 +308,6 @@ intToText :: Integral a => a -> T.Text
 | 
			
		||||
intToText = TL.toStrict . B.toLazyText . B.decimal
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
removeLensFieldLabel :: String -> String
 | 
			
		||||
removeLensFieldLabel str' =
 | 
			
		||||
  maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
pvpToVersion :: MonadThrow m => PVP -> Text -> m Version
 | 
			
		||||
pvpToVersion pvp_ rest =
 | 
			
		||||
  either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user