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
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Utils.File
|
|
||||||
import GHCup.Utils.Logger
|
import GHCup.Utils.Logger
|
||||||
import GHCup.Utils.String.QQ
|
import GHCup.Utils.String.QQ
|
||||||
|
|
||||||
|
@ -65,6 +65,7 @@ library
|
|||||||
GHCup.Requirements
|
GHCup.Requirements
|
||||||
GHCup.Types
|
GHCup.Types
|
||||||
GHCup.Types.JSON
|
GHCup.Types.JSON
|
||||||
|
GHCup.Types.JSON.Utils
|
||||||
GHCup.Types.Optics
|
GHCup.Types.Optics
|
||||||
GHCup.Utils
|
GHCup.Utils
|
||||||
GHCup.Utils.Dirs
|
GHCup.Utils.Dirs
|
||||||
|
@ -6,6 +6,7 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
@ -30,12 +31,15 @@ import Data.Map.Strict ( Map )
|
|||||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
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
|
import URI.ByteString
|
||||||
#if defined(BRICK)
|
#if defined(BRICK)
|
||||||
import Graphics.Vty ( Key(..) )
|
import Graphics.Vty ( Key(..) )
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
|
|
||||||
@ -600,3 +604,27 @@ data LoggerConfig = LoggerConfig
|
|||||||
|
|
||||||
instance NFData LoggerConfig where
|
instance NFData LoggerConfig where
|
||||||
rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
|
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
|
module GHCup.Types.JSON where
|
||||||
|
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
import GHCup.Types.JSON.Utils
|
||||||
import GHCup.Utils.MegaParsec
|
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 Control.Applicative ( (<|>) )
|
||||||
import Data.Aeson hiding (Key)
|
import Data.Aeson hiding (Key)
|
||||||
@ -40,6 +38,7 @@ import Text.Casing
|
|||||||
|
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding.Error as E
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import qualified Text.Megaparsec.Char as MPC
|
import qualified Text.Megaparsec.Char as MPC
|
||||||
|
|
||||||
@ -78,7 +77,7 @@ instance FromJSON Tag where
|
|||||||
x -> pure (UnknownTag x)
|
x -> pure (UnknownTag x)
|
||||||
|
|
||||||
instance ToJSON URI where
|
instance ToJSON URI where
|
||||||
toJSON = toJSON . decUTF8Safe . serializeURIRef'
|
toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
|
||||||
|
|
||||||
instance FromJSON URI where
|
instance FromJSON URI where
|
||||||
parseJSON = withText "URL" $ \t ->
|
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 FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
|
@ -1,11 +1,15 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# 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.Utils.Prelude
|
||||||
|
import GHCup.Types(ProcessError(..), CapturedProcess(..))
|
||||||
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Maybe
|
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.
|
-- | Search for a file in the search paths.
|
||||||
--
|
--
|
||||||
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
|
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
@ -18,7 +17,7 @@ module GHCup.Utils.Logger where
|
|||||||
|
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import {-# SOURCE #-} GHCup.Utils.File.Common
|
import {-# SOURCE #-} GHCup.Utils.File.Common (findFiles)
|
||||||
import GHCup.Utils.String.QQ
|
import GHCup.Utils.String.QQ
|
||||||
|
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
|
@ -1,7 +1,5 @@
|
|||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module GHCup.Utils.Logger where
|
module GHCup.Utils.Logger where
|
||||||
|
|
||||||
|
@ -30,7 +30,7 @@ where
|
|||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import {-# SOURCE #-} GHCup.Utils.Logger
|
import {-# SOURCE #-} GHCup.Utils.Logger (logWarn)
|
||||||
#if defined(IS_WINDOWS)
|
#if defined(IS_WINDOWS)
|
||||||
import GHCup.Utils.Prelude.Windows
|
import GHCup.Utils.Prelude.Windows
|
||||||
#else
|
#else
|
||||||
@ -308,11 +308,6 @@ intToText :: Integral a => a -> T.Text
|
|||||||
intToText = TL.toStrict . B.toLazyText . B.decimal
|
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 :: MonadThrow m => PVP -> Text -> m Version
|
||||||
pvpToVersion pvp_ rest =
|
pvpToVersion pvp_ rest =
|
||||||
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
|
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
|
||||||
|
Loading…
Reference in New Issue
Block a user