{-# OPTIONS_GHC -Wno-orphans #-}

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}

module StackageToHackage.Stackage.YAML where

import StackageToHackage.Prelude
import StackageToHackage.Stackage.Types


import Control.Applicative ((<|>))
import Data.Semigroup
import Data.Text (Text, isSuffixOf, takeWhile, unpack)
import Data.YAML
    ( FromYAML
    , Mapping
    , Node(..)
    , Parser
    , Pos(..)
    , Scalar(..)
    , parseYAML
    , withMap
    , withStr
    , (.!=)
    , (.:)
    , (.:?)
    )
import Distribution.Text (simpleParse)
import Prelude hiding (head, reverse, takeWhile)

import qualified Data.Map.Strict as M


fakePos :: Pos
fakePos :: Pos
fakePos = Pos :: Int -> Int -> Int -> Int -> Pos
Pos
  { posByteOffset :: Int
posByteOffset = -Int
1 , posCharOffset :: Int
posCharOffset = -Int
1  , posLine :: Int
posLine = Int
1 , posColumn :: Int
posColumn = Int
0 }


instance FromYAML Stack where
   parseYAML :: Node Pos -> Parser Stack
parseYAML = String -> (Mapping Pos -> Parser Stack) -> Node Pos -> Parser Stack
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"Stack" ((Mapping Pos -> Parser Stack) -> Node Pos -> Parser Stack)
-> (Mapping Pos -> Parser Stack) -> Node Pos -> Parser Stack
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> ResolverRef
-> Maybe Ghc -> [Package] -> [Dep] -> Flags -> GhcOptions -> Stack
Stack
       (ResolverRef
 -> Maybe Ghc -> [Package] -> [Dep] -> Flags -> GhcOptions -> Stack)
-> Parser ResolverRef
-> Parser
     (Maybe Ghc -> [Package] -> [Dep] -> Flags -> GhcOptions -> Stack)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Pos
m Mapping Pos -> Text -> Parser ResolverRef
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"resolver"
       Parser
  (Maybe Ghc -> [Package] -> [Dep] -> Flags -> GhcOptions -> Stack)
-> Parser (Maybe Ghc)
-> Parser ([Package] -> [Dep] -> Flags -> GhcOptions -> Stack)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Ghc)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"compiler"
       Parser ([Package] -> [Dep] -> Flags -> GhcOptions -> Stack)
-> Parser [Package]
-> Parser ([Dep] -> Flags -> GhcOptions -> Stack)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Package])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"packages" Parser (Maybe [Package]) -> [Package] -> Parser [Package]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Package]
forall a. Monoid a => a
mempty
       Parser ([Dep] -> Flags -> GhcOptions -> Stack)
-> Parser [Dep] -> Parser (Flags -> GhcOptions -> Stack)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Dep])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"extra-deps" Parser (Maybe [Dep]) -> [Dep] -> Parser [Dep]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Dep]
forall a. Monoid a => a
mempty
       Parser (Flags -> GhcOptions -> Stack)
-> Parser Flags -> Parser (GhcOptions -> Stack)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Flags)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"flags" Parser (Maybe Flags) -> Flags -> Parser Flags
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Map Text Bool) -> Flags
Flags Map Text (Map Text Bool)
forall k a. Map k a
M.empty
       Parser (GhcOptions -> Stack) -> Parser GhcOptions -> Parser Stack
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe GhcOptions)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"ghc-options" Parser (Maybe GhcOptions) -> GhcOptions -> Parser GhcOptions
forall a. Parser (Maybe a) -> a -> Parser a
.!= GhcOptions
emptyGhcOptions

instance FromYAML GhcOptions where
  parseYAML :: Node Pos -> Parser GhcOptions
parseYAML = String
-> (Mapping Pos -> Parser GhcOptions)
-> Node Pos
-> Parser GhcOptions
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"GhcOptions" ((Mapping Pos -> Parser GhcOptions)
 -> Node Pos -> Parser GhcOptions)
-> (Mapping Pos -> Parser GhcOptions)
-> Node Pos
-> Parser GhcOptions
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> do
      Maybe Text
locals <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Text)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"$locals"
      Maybe Text
targets <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Text)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"$targets"
      Maybe Text
everything <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Text)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"$everything"
      PackageGhcOpts
packagesGhcOpts <- Map PkgId Text -> PackageGhcOpts
PackageGhcOpts (Map PkgId Text -> PackageGhcOpts)
-> Parser (Map PkgId Text) -> Parser PackageGhcOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (Node Pos
 -> Node Pos -> Parser (Map PkgId Text) -> Parser (Map PkgId Text))
-> Parser (Map PkgId Text)
-> Mapping Pos
-> Parser (Map PkgId Text)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\Node Pos
k Node Pos
a Parser (Map PkgId Text)
action -> do
              Map PkgId Text
m1 <- String
-> (Text -> Parser (Map PkgId Text))
-> Node Pos
-> Parser (Map PkgId Text)
forall a. String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr String
"val" (\Text
val -> do
                  PkgId
key <- Node Pos -> Parser PkgId
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
k
                  Map PkgId Text -> Parser (Map PkgId Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgId -> Text -> Map PkgId Text
forall k a. k -> a -> Map k a
M.singleton PkgId
key Text
val)) Node Pos
a
              Map PkgId Text
m2 <- Parser (Map PkgId Text)
action
              Map PkgId Text -> Parser (Map PkgId Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map PkgId Text
m1 Map PkgId Text -> Map PkgId Text -> Map PkgId Text
forall a. Semigroup a => a -> a -> a
<> Map PkgId Text
m2)
              ) (Map PkgId Text -> Parser (Map PkgId Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map PkgId Text
forall k a. Map k a
M.empty) (Mapping Pos -> Mapping Pos
forall a. Map (Node Pos) a -> Map (Node Pos) a
newMap Mapping Pos
m)
      GhcOptions -> Parser GhcOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GhcOptions -> Parser GhcOptions)
-> GhcOptions -> Parser GhcOptions
forall a b. (a -> b) -> a -> b
$ GhcOptions :: Maybe Text
-> Maybe Text -> Maybe Text -> PackageGhcOpts -> GhcOptions
GhcOptions{Maybe Text
PackageGhcOpts
$sel:packagesGhcOpts:GhcOptions :: PackageGhcOpts
$sel:everything:GhcOptions :: Maybe Text
$sel:targets:GhcOptions :: Maybe Text
$sel:locals:GhcOptions :: Maybe Text
packagesGhcOpts :: PackageGhcOpts
everything :: Maybe Text
targets :: Maybe Text
locals :: Maybe Text
..}
   where
    newMap :: Map (Node Pos) a -> Map (Node Pos) a
newMap Map (Node Pos) a
m =
        Text -> Node Pos
node Text
"$everything" Node Pos -> Map (Node Pos) a -> Map (Node Pos) a
forall k a. Ord k => k -> Map k a -> Map k a
`M.delete`
            (Text -> Node Pos
node Text
"$targets" Node Pos -> Map (Node Pos) a -> Map (Node Pos) a
forall k a. Ord k => k -> Map k a -> Map k a
`M.delete`
                (Text -> Node Pos
node Text
"$locals" Node Pos -> Map (Node Pos) a -> Map (Node Pos) a
forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` Map (Node Pos) a
m))
    node :: Text -> Node Pos
node = Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
Scalar Pos
fakePos (Scalar -> Node Pos) -> (Text -> Scalar) -> Text -> Node Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Scalar
SStr

instance FromYAML Git where
  parseYAML :: Node Pos -> Parser Git
parseYAML = String -> (Mapping Pos -> Parser Git) -> Node Pos -> Parser Git
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"Git" ((Mapping Pos -> Parser Git) -> Node Pos -> Parser Git)
-> (Mapping Pos -> Parser Git) -> Node Pos -> Parser Git
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> Text -> Text -> [Text] -> Git
Git
      (Text -> Text -> [Text] -> Git)
-> Parser Text -> Parser (Text -> [Text] -> Git)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mapping Pos
m Mapping Pos -> Text -> Parser Text
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"git" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mapping Pos -> Parser Text
forall b.
(Semigroup b, IsString b, FromYAML b) =>
Mapping Pos -> Parser b
github Mapping Pos
m)
      Parser (Text -> [Text] -> Git)
-> Parser Text -> Parser ([Text] -> Git)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser Text
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"commit"
      Parser ([Text] -> Git) -> Parser [Text] -> Parser Git
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Text])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"subdirs" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    where github :: Mapping Pos -> Parser b
github Mapping Pos
m = (\b
x -> b
"https://github.com/" b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
".git") (b -> b) -> Parser b -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mapping Pos
m Mapping Pos -> Text -> Parser b
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"github")

instance FromYAML ResolverRef where
  parseYAML :: Node Pos -> Parser ResolverRef
parseYAML = String
-> (Text -> Parser ResolverRef) -> Node Pos -> Parser ResolverRef
forall a. String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr String
"ResolverRef" ((Text -> Parser ResolverRef) -> Node Pos -> Parser ResolverRef)
-> (Text -> Parser ResolverRef) -> Node Pos -> Parser ResolverRef
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      if Text
".yaml" Text -> Text -> Bool
`isSuffixOf` Text
s
      then (ResolverRef -> Parser ResolverRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverRef -> Parser ResolverRef)
-> (Text -> ResolverRef) -> Text -> Parser ResolverRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ResolverRef
Snapshot) Text
s
      else (ResolverRef -> Parser ResolverRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverRef -> Parser ResolverRef)
-> (Text -> ResolverRef) -> Text -> Parser ResolverRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ResolverRef
Canned) Text
s

instance FromYAML Package where
  parseYAML :: Node Pos -> Parser Package
parseYAML Node Pos
n = Node Pos -> Parser Package
local Node Pos
n Parser Package -> Parser Package -> Parser Package
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Node Pos -> Parser Package
location Node Pos
n
    where
      local :: Node Pos -> Parser Package
local = String -> (Text -> Parser Package) -> Node Pos -> Parser Package
forall a. String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr String
"Local" ((Text -> Parser Package) -> Node Pos -> Parser Package)
-> (Text -> Parser Package) -> Node Pos -> Parser Package
forall a b. (a -> b) -> a -> b
$ Package -> Parser Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> Parser Package)
-> (Text -> Package) -> Text -> Parser Package
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Package
Local (String -> Package) -> (Text -> String) -> Text -> Package
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
      location :: Node Pos -> Parser Package
location = String
-> (Mapping Pos -> Parser Package) -> Node Pos -> Parser Package
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"Location" ((Mapping Pos -> Parser Package) -> Node Pos -> Parser Package)
-> (Mapping Pos -> Parser Package) -> Node Pos -> Parser Package
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m ->
          Git -> Package
Location (Git -> Package) -> Parser Git -> Parser Package
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Pos
m Mapping Pos -> Text -> Parser Git
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"location"

instance FromYAML Dep where
   parseYAML :: Node Pos -> Parser Dep
parseYAML Node Pos
n = Parser Dep
hackage Parser Dep -> Parser Dep -> Parser Dep
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Dep
source Parser Dep -> Parser Dep -> Parser Dep
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Dep
local
     where
       hackage :: Parser Dep
hackage = PkgId -> Dep
Hackage (PkgId -> Dep) -> Parser PkgId -> Parser Dep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser PkgId
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
n
       source :: Parser Dep
source = Git -> Dep
SourceDep (Git -> Dep) -> Parser Git -> Parser Dep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser Git
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
n
       local :: Parser Dep
local = String -> Dep
LocalDep (String -> Dep) -> (Text -> String) -> Text -> Dep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Dep) -> Parser Text -> Parser Dep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser Text
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
n

instance FromYAML Resolver where
  parseYAML :: Node Pos -> Parser Resolver
parseYAML = String
-> (Mapping Pos -> Parser Resolver) -> Node Pos -> Parser Resolver
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"Resolver" ((Mapping Pos -> Parser Resolver) -> Node Pos -> Parser Resolver)
-> (Mapping Pos -> Parser Resolver) -> Node Pos -> Parser Resolver
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> Maybe ResolverRef -> Maybe Ghc -> [Dep] -> Flags -> Resolver
Resolver
      (Maybe ResolverRef -> Maybe Ghc -> [Dep] -> Flags -> Resolver)
-> Parser (Maybe ResolverRef)
-> Parser (Maybe Ghc -> [Dep] -> Flags -> Resolver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe ResolverRef)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"resolver"
      Parser (Maybe Ghc -> [Dep] -> Flags -> Resolver)
-> Parser (Maybe Ghc) -> Parser ([Dep] -> Flags -> Resolver)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Ghc)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"compiler"
      Parser ([Dep] -> Flags -> Resolver)
-> Parser [Dep] -> Parser (Flags -> Resolver)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Dep])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"packages" Parser (Maybe [Dep]) -> [Dep] -> Parser [Dep]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Dep]
forall a. Monoid a => a
mempty
      Parser (Flags -> Resolver) -> Parser Flags -> Parser Resolver
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Flags)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"flags" Parser (Maybe Flags) -> Flags -> Parser Flags
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Map Text Bool) -> Flags
Flags Map Text (Map Text Bool)
forall k a. Map k a
M.empty

instance FromYAML NewDep where
   parseYAML :: Node Pos -> Parser NewDep
parseYAML = String
-> (Mapping Pos -> Parser NewDep) -> Node Pos -> Parser NewDep
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"NewDep" ((Mapping Pos -> Parser NewDep) -> Node Pos -> Parser NewDep)
-> (Mapping Pos -> Parser NewDep) -> Node Pos -> Parser NewDep
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> Node Pos -> Parser NewDep
hackage' (Node Pos -> Parser NewDep) -> Parser (Node Pos) -> Parser NewDep
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Mapping Pos
m Mapping Pos -> Text -> Parser (Node Pos)
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"hackage"
     where
       hackage' :: Node Pos -> Parser NewDep
hackage' Node Pos
n = PkgId -> NewDep
NewDep (PkgId -> NewDep) -> Parser PkgId -> Parser NewDep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser PkgId
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
n

instance FromYAML NewResolver where
  parseYAML :: Node Pos -> Parser NewResolver
parseYAML = String
-> (Mapping Pos -> Parser NewResolver)
-> Node Pos
-> Parser NewResolver
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"NewResolver" ((Mapping Pos -> Parser NewResolver)
 -> Node Pos -> Parser NewResolver)
-> (Mapping Pos -> Parser NewResolver)
-> Node Pos
-> Parser NewResolver
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> Ghc -> [NewDep] -> Flags -> NewResolver
NewResolver
      (Ghc -> [NewDep] -> Flags -> NewResolver)
-> Parser Ghc -> Parser ([NewDep] -> Flags -> NewResolver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mapping Pos
m Mapping Pos -> Text -> Parser Ghc
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"compiler" Parser Ghc -> Parser Ghc -> Parser Ghc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mapping Pos
m Mapping Pos -> (Text, Text) -> Parser Ghc
forall a. FromYAML a => Mapping Pos -> (Text, Text) -> Parser a
..: (Text
"resolver", Text
"compiler"))
      Parser ([NewDep] -> Flags -> NewResolver)
-> Parser [NewDep] -> Parser (Flags -> NewResolver)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [NewDep])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"packages" Parser (Maybe [NewDep]) -> [NewDep] -> Parser [NewDep]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [NewDep]
forall a. Monoid a => a
mempty
      Parser (Flags -> NewResolver) -> Parser Flags -> Parser NewResolver
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Flags)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"flags" Parser (Maybe Flags) -> Flags -> Parser Flags
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Map Text Bool) -> Flags
Flags Map Text (Map Text Bool)
forall k a. Map k a
M.empty
    where
      (..:) :: FromYAML a => Mapping Pos -> (Text, Text) -> Parser a
      Mapping Pos
m1 ..: :: Mapping Pos -> (Text, Text) -> Parser a
..: (Text
k1, Text
k2) =
          case Node Pos -> Mapping Pos -> Maybe (Node Pos)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
Scalar Pos
fakePos (Text -> Scalar
SStr Text
k1)) Mapping Pos
m1 of
              Just (Mapping Pos
_ Tag
_ Mapping Pos
m2) -> Mapping Pos
m2 Mapping Pos -> Text -> Parser a
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
k2
              Maybe (Node Pos)
_ -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"

instance FromYAML PkgId where
  parseYAML :: Node Pos -> Parser PkgId
parseYAML = String -> (Text -> Parser PkgId) -> Node Pos -> Parser PkgId
forall a. String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr String
"PackageIdentifier" ((Text -> Parser PkgId) -> Node Pos -> Parser PkgId)
-> (Text -> Parser PkgId) -> Node Pos -> Parser PkgId
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      PackageIdentifier -> PkgId
PkgId (PackageIdentifier -> PkgId)
-> Parser PackageIdentifier -> Parser PkgId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe PackageIdentifier -> Parser PackageIdentifier
forall (m :: * -> *) a. Alternative m => Maybe a -> m a
hoistMaybe (Maybe PackageIdentifier -> Parser PackageIdentifier)
-> (Text -> Maybe PackageIdentifier)
-> Text
-> Parser PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe PackageIdentifier
forall a. Parsec a => String -> Maybe a
simpleParse (String -> Maybe PackageIdentifier)
-> (Text -> String) -> Text -> Maybe PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) ((Char -> Bool) -> Text -> Text
takeWhile (Char
'@' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) Text
s)


deriving instance FromYAML Ghc
deriving instance FromYAML PackageGhcOpts
deriving instance FromYAML Flags