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