Merge branch 'improve-config'
This commit is contained in:
commit
168f2e6d16
@ -14,6 +14,7 @@ import GHCup.Utils.Dirs
|
|||||||
import GHCup.Utils.Logger
|
import GHCup.Utils.Logger
|
||||||
import GHCup.Types.JSON ( )
|
import GHCup.Types.JSON ( )
|
||||||
|
|
||||||
|
import Control.Exception ( displayException )
|
||||||
import Control.Monad.Trans.Reader ( runReaderT )
|
import Control.Monad.Trans.Reader ( runReaderT )
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Data.Char ( toLower )
|
import Data.Char ( toLower )
|
||||||
@ -34,7 +35,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
|||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.YAML.Aeson as Y
|
import qualified Data.Yaml.Aeson as Y
|
||||||
|
|
||||||
|
|
||||||
data Options = Options
|
data Options = Options
|
||||||
@ -147,8 +148,8 @@ main = do
|
|||||||
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
||||||
B.readFile file >>= valAndExit f
|
B.readFile file >>= valAndExit f
|
||||||
valAndExit f contents = do
|
valAndExit f contents = do
|
||||||
(GHCupInfo _ av gt) <- case Y.decode1Strict contents of
|
(GHCupInfo _ av gt) <- case Y.decodeEither' contents of
|
||||||
Right r -> pure r
|
Right r -> pure r
|
||||||
Left (_, e) -> die (color Red $ show e)
|
Left e -> die (color Red $ displayException e)
|
||||||
f av gt
|
f av gt
|
||||||
>>= exitWith
|
>>= exitWith
|
||||||
|
@ -21,9 +21,9 @@ import GHCup.Utils.String.QQ
|
|||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
|
import Control.Exception ( displayException )
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
import Data.Bifunctor
|
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
@ -34,7 +34,7 @@ import System.Exit
|
|||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.ByteString.UTF8 as UTF8
|
import qualified Data.ByteString.UTF8 as UTF8
|
||||||
import qualified Data.YAML.Aeson as Y
|
import qualified Data.Yaml.Aeson as Y
|
||||||
import Control.Exception.Safe (MonadMask)
|
import Control.Exception.Safe (MonadMask)
|
||||||
|
|
||||||
|
|
||||||
@ -111,12 +111,12 @@ configSetFooter = [s|Examples:
|
|||||||
|
|
||||||
|
|
||||||
formatConfig :: UserSettings -> String
|
formatConfig :: UserSettings -> String
|
||||||
formatConfig = UTF8.toString . Y.encode1Strict
|
formatConfig = UTF8.toString . Y.encode
|
||||||
|
|
||||||
|
|
||||||
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
|
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
|
||||||
updateSettings config' settings = do
|
updateSettings config' settings = do
|
||||||
settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config'
|
settings' <- lE' (JSONDecodeError . displayException) . Y.decodeEither' $ config'
|
||||||
pure $ mergeConf settings' settings
|
pure $ mergeConf settings' settings
|
||||||
where
|
where
|
||||||
mergeConf :: UserSettings -> Settings -> Settings
|
mergeConf :: UserSettings -> Settings -> Settings
|
||||||
|
@ -17,11 +17,6 @@ source-repository-package
|
|||||||
location: https://github.com/hasufell/aeson-pretty.git
|
location: https://github.com/hasufell/aeson-pretty.git
|
||||||
tag: e902ab866bb41d990b66af3644aeb352ff7aaf6f
|
tag: e902ab866bb41d990b66af3644aeb352ff7aaf6f
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/hasufell/HsYAML-aeson.git
|
|
||||||
tag: b4b4ab8592918b52a9f2e5bb0c5a795b9721b4f3
|
|
||||||
|
|
||||||
package libarchive
|
package libarchive
|
||||||
flags: -system-libarchive
|
flags: -system-libarchive
|
||||||
|
|
||||||
|
@ -109,7 +109,6 @@ library
|
|||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, haskus-utils-types ^>=1.5
|
, haskus-utils-types ^>=1.5
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant >=3.0 && <3.2
|
||||||
, HsYAML-aeson ^>=0.2.0.0
|
|
||||||
, libarchive ^>=3.0.3.0
|
, libarchive ^>=3.0.3.0
|
||||||
, lzma-static ^>=5.2.5.3
|
, lzma-static ^>=5.2.5.3
|
||||||
, megaparsec >=8.0.0 && <9.1
|
, megaparsec >=8.0.0 && <9.1
|
||||||
@ -136,6 +135,7 @@ library
|
|||||||
, vector ^>=0.12
|
, vector ^>=0.12
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
, word8 ^>=0.1.3
|
, word8 ^>=0.1.3
|
||||||
|
, yaml-streamly ^>=0.12.0
|
||||||
, zlib ^>=0.6.2.2
|
, zlib ^>=0.6.2.2
|
||||||
|
|
||||||
if (flag(internal-downloader) && !os(windows))
|
if (flag(internal-downloader) && !os(windows))
|
||||||
@ -225,7 +225,6 @@ executable ghcup
|
|||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant >=3.0 && <3.2
|
||||||
, HsYAML-aeson ^>=0.2.0.0
|
|
||||||
, libarchive ^>=3.0.3.0
|
, libarchive ^>=3.0.3.0
|
||||||
, megaparsec >=8.0.0 && <9.1
|
, megaparsec >=8.0.0 && <9.1
|
||||||
, mtl ^>=2.2
|
, mtl ^>=2.2
|
||||||
@ -240,6 +239,7 @@ executable ghcup
|
|||||||
, uri-bytestring ^>=0.3.2.2
|
, uri-bytestring ^>=0.3.2.2
|
||||||
, utf8-string ^>=1.0
|
, utf8-string ^>=1.0
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
|
, yaml-streamly ^>=0.12.0
|
||||||
|
|
||||||
if flag(internal-downloader)
|
if flag(internal-downloader)
|
||||||
cpp-options: -DINTERNAL_DOWNLOADER
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
@ -287,7 +287,6 @@ executable ghcup-gen
|
|||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant >=3.0 && <3.2
|
||||||
, HsYAML-aeson ^>=0.2.0.0
|
|
||||||
, libarchive ^>=3.0.3.0
|
, libarchive ^>=3.0.3.0
|
||||||
, mtl ^>=2.2
|
, mtl ^>=2.2
|
||||||
, optics ^>=0.4
|
, optics ^>=0.4
|
||||||
@ -300,6 +299,7 @@ executable ghcup-gen
|
|||||||
, text ^>=1.2.4.0
|
, text ^>=1.2.4.0
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
|
, yaml-streamly ^>=0.12.0
|
||||||
|
|
||||||
test-suite ghcup-test
|
test-suite ghcup-test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
@ -49,7 +49,6 @@ import Control.Monad.Reader
|
|||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Bifunctor
|
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
#if defined(INTERNAL_DOWNLOADER)
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
import Data.CaseInsensitive ( mk )
|
import Data.CaseInsensitive ( mk )
|
||||||
@ -87,7 +86,7 @@ import qualified Data.Map.Strict as M
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Data.YAML.Aeson as Y
|
import qualified Data.Yaml.Aeson as Y
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -183,15 +182,14 @@ getBase uri = do
|
|||||||
|
|
||||||
-- if we didn't get a filepath from the download, use the cached yaml
|
-- if we didn't get a filepath from the download, use the cached yaml
|
||||||
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
||||||
yamlContents <- liftIOException doesNotExistErrorType (FileDoesNotExistError actualYaml) $ liftIO $ L.readFile actualYaml
|
|
||||||
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
||||||
|
|
||||||
liftE
|
liftE
|
||||||
. onE_ (onError actualYaml)
|
. onE_ (onError actualYaml)
|
||||||
. lE' @_ @_ @'[JSONError] JSONDecodeError
|
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||||
. first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
. liftIO
|
||||||
. Y.decode1
|
. Y.decodeFileEither
|
||||||
$ yamlContents
|
$ actualYaml
|
||||||
where
|
where
|
||||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||||
-- may re-download and succeed.
|
-- may re-download and succeed.
|
||||||
|
@ -57,7 +57,7 @@ import System.IO.Temp
|
|||||||
|
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.YAML.Aeson as Y
|
import qualified Data.Yaml.Aeson as Y
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
|
|
||||||
@ -211,7 +211,7 @@ ghcupConfigFile = do
|
|||||||
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
|
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
|
||||||
case contents of
|
case contents of
|
||||||
Nothing -> pure defaultUserSettings
|
Nothing -> pure defaultUserSettings
|
||||||
Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents'
|
Just contents' -> lE' JSONDecodeError . first displayException . Y.decodeEither' $ contents'
|
||||||
|
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
|
@ -17,6 +17,7 @@ extra-deps:
|
|||||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||||
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
|
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
|
||||||
|
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
||||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
||||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
||||||
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
|
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
|
||||||
@ -25,6 +26,7 @@ extra-deps:
|
|||||||
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
||||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
||||||
- libarchive-3.0.3.0
|
- libarchive-3.0.3.0
|
||||||
|
- libyaml-streamly-0.2.0
|
||||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
||||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
||||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
||||||
@ -33,11 +35,10 @@ extra-deps:
|
|||||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
||||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
||||||
- regex-posix-clib-2.7
|
- regex-posix-clib-2.7
|
||||||
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
|
- streamly-0.8.0@sha256:9784c80ee1ada51477520cabc4e92a0c76a6bb265f968a188f2fce818e7398e0,19654
|
||||||
- streamly-bytestring-0.1.2@sha256:cc828f41d1c714c711d38fb213b4ed186febabba598ab080e13255f69c20b13c,2469
|
|
||||||
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
|
|
||||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||||
|
- yaml-streamly-0.12.0
|
||||||
|
|
||||||
flags:
|
flags:
|
||||||
http-io-streams:
|
http-io-streams:
|
||||||
|
Loading…
Reference in New Issue
Block a user