hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Switch to yaml-streamly

Browse Source
This commit is contained in:
Julian Ospald
2021-10-21 23:17:26 +02:00
parent 2a11e85a95
commit 4574f3aa4f
7 changed files with 22 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
app/ghcup-gen/Main.hs
View File

@@ -14,6 +14,7 @@ import GHCup.Utils.Dirs
import GHCup.Utils.Logger
import GHCup.Types.JSON ( )
import Control.Exception ( displayException )
import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.IO.Class
import Data.Char ( toLower )
@@ -34,7 +35,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text.IO as T
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.YAML.Aeson as Y
import qualified Data.Yaml.Aeson as Y
data Options = Options
@@ -147,8 +148,8 @@ main = do
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit f
valAndExit f contents = do
(GHCupInfo _ av gt) <- case Y.decode1Strict contents of
(GHCupInfo _ av gt) <- case Y.decodeEither' contents of
Right r -> pure r
Left (_, e) -> die (color Red $ show e)
Left e -> die (color Red $ displayException e)
f av gt
>>= exitWith

8
app/ghcup/GHCup/OptParse/Config.hs
View File

@@ -21,9 +21,9 @@ import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Exception ( displayException )
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Bifunctor
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
@@ -34,7 +34,7 @@ import System.Exit
import qualified Data.Text as T
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)
@@ -111,12 +111,12 @@ configSetFooter = [s|Examples:
formatConfig :: UserSettings -> String
formatConfig = UTF8.toString . Y.encode1Strict
formatConfig = UTF8.toString . Y.encode
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
updateSettings config' settings = do
settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config'
settings' <- lE' (JSONDecodeError . displayException) . Y.decodeEither' $ config'
pure $ mergeConf settings' settings
where
mergeConf :: UserSettings -> Settings -> Settings