deps: use yaml instead of HsYAML due to GPL

This commit is contained in:
1computer1 2020-06-20 17:47:37 -04:00
parent 55816085e0
commit 50729ae109
2 changed files with 13 additions and 12 deletions

View File

@ -50,7 +50,6 @@ common shared
, bytestring , bytestring
, containers , containers
, filepath , filepath
, HsYAML >= 0.2
, lifted-async , lifted-async
, lifted-base , lifted-base
, monad-control , monad-control
@ -68,6 +67,7 @@ common shared
, typed-process , typed-process
, wai , wai
, warp , warp
, yaml
library library
import: shared import: shared

View File

@ -9,10 +9,11 @@ module Myriad.Config
, readConfig , readConfig
) where ) where
import qualified Data.ByteString.Lazy as BL import Data.Aeson
import qualified Data.ByteString as B
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.YAML import Data.Yaml
import Optics import Optics
@ -49,8 +50,8 @@ data DefaultLanguage = DefaultLanguage
makeFieldLabelsWith classUnderscoreNoPrefixFields ''DefaultLanguage makeFieldLabelsWith classUnderscoreNoPrefixFields ''DefaultLanguage
instance FromYAML DefaultLanguage where instance FromJSON DefaultLanguage where
parseYAML = withMap "default language" $ \m -> DefaultLanguage parseJSON = withObject "default language" $ \m -> DefaultLanguage
<$> m .: "memory" <$> m .: "memory"
<*> m .: "cpus" <*> m .: "cpus"
<*> m .: "timeout" <*> m .: "timeout"
@ -68,8 +69,8 @@ data RawLanguage = RawLanguage
makeFieldLabelsWith classUnderscoreNoPrefixFields ''RawLanguage makeFieldLabelsWith classUnderscoreNoPrefixFields ''RawLanguage
instance FromYAML RawLanguage where instance FromJSON RawLanguage where
parseYAML = withMap "language" $ \m -> RawLanguage parseJSON = withObject "language" $ \m -> RawLanguage
<$> m .: "name" <$> m .: "name"
<*> m .:? "memory" <*> m .:? "memory"
<*> m .:? "cpus" <*> m .:? "cpus"
@ -88,8 +89,8 @@ data RawConfig = RawConfig
makeFieldLabelsWith classUnderscoreNoPrefixFields ''RawConfig makeFieldLabelsWith classUnderscoreNoPrefixFields ''RawConfig
instance FromYAML RawConfig where instance FromJSON RawConfig where
parseYAML = withMap "config" $ \m -> RawConfig parseJSON = withObject "config" $ \m -> RawConfig
<$> m .: "languages" <$> m .: "languages"
<*> m .: "defaultLanguage" <*> m .: "defaultLanguage"
<*> m .: "buildConcurrently" <*> m .: "buildConcurrently"
@ -102,9 +103,9 @@ readConfig = fmap fromRawConfig . readRawConfig
readRawConfig :: FilePath -> IO RawConfig readRawConfig :: FilePath -> IO RawConfig
readRawConfig f = do readRawConfig f = do
x <- BL.readFile f x <- B.readFile f
case decode1 x of case Data.Yaml.decodeEither' x of
Left (pos, e) -> error $ prettyPosWithSource pos x e Left e -> error $ prettyPrintParseException e
Right y -> pure y Right y -> pure y
fromRawConfig :: RawConfig -> Config fromRawConfig :: RawConfig -> Config