-- |
-- Module: Staversion.Internal.Cabal
-- Description: functions dealing with .cabal files.
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
module Staversion.Internal.Cabal
       ( loadCabalFile,
         Target(..),
         BuildDepends(..)
       ) where

import Control.Applicative ((<*), (*>), (<|>), (<*>), many, some)
import Control.Exception (IOException)
import qualified Control.Exception as Exception
import Control.Monad (void, mzero, forM)
import Data.Bifunctor (first)
import Data.Char (isAlpha, isDigit, toLower, isSpace)
import Data.List (intercalate, nub)
import Data.Monoid (mconcat)
import Data.Text (pack, Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

import qualified Staversion.Internal.Megaparsec as P
import Staversion.Internal.Query
  ( PackageName, ErrorMsg
  )

-- | Build target type.
data Target = TargetLibrary -- ^ the @library@ target.
            | TargetExecutable Text -- ^ the @executable NAME@ target.
            | TargetTestSuite Text -- ^ the @test-suite NAME@ target.
            | TargetBenchmark Text -- ^ the @benchmark NAME@ target.
            deriving (Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show,Target -> Target -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq,Eq Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmax :: Target -> Target -> Target
>= :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c< :: Target -> Target -> Bool
compare :: Target -> Target -> Ordering
$ccompare :: Target -> Target -> Ordering
Ord)

-- | A block of @build-depends:@.
data BuildDepends =
  BuildDepends { BuildDepends -> Target
depsTarget :: Target,
                 BuildDepends -> [Text]
depsPackages :: [PackageName]
               } deriving (Int -> BuildDepends -> ShowS
[BuildDepends] -> ShowS
BuildDepends -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildDepends] -> ShowS
$cshowList :: [BuildDepends] -> ShowS
show :: BuildDepends -> String
$cshow :: BuildDepends -> String
showsPrec :: Int -> BuildDepends -> ShowS
$cshowsPrec :: Int -> BuildDepends -> ShowS
Show,BuildDepends -> BuildDepends -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildDepends -> BuildDepends -> Bool
$c/= :: BuildDepends -> BuildDepends -> Bool
== :: BuildDepends -> BuildDepends -> Bool
$c== :: BuildDepends -> BuildDepends -> Bool
Eq,Eq BuildDepends
BuildDepends -> BuildDepends -> Bool
BuildDepends -> BuildDepends -> Ordering
BuildDepends -> BuildDepends -> BuildDepends
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BuildDepends -> BuildDepends -> BuildDepends
$cmin :: BuildDepends -> BuildDepends -> BuildDepends
max :: BuildDepends -> BuildDepends -> BuildDepends
$cmax :: BuildDepends -> BuildDepends -> BuildDepends
>= :: BuildDepends -> BuildDepends -> Bool
$c>= :: BuildDepends -> BuildDepends -> Bool
> :: BuildDepends -> BuildDepends -> Bool
$c> :: BuildDepends -> BuildDepends -> Bool
<= :: BuildDepends -> BuildDepends -> Bool
$c<= :: BuildDepends -> BuildDepends -> Bool
< :: BuildDepends -> BuildDepends -> Bool
$c< :: BuildDepends -> BuildDepends -> Bool
compare :: BuildDepends -> BuildDepends -> Ordering
$ccompare :: BuildDepends -> BuildDepends -> Ordering
Ord)

loadCabalFile :: FilePath -> IO (Either ErrorMsg [BuildDepends])
loadCabalFile :: String -> IO (Either String [BuildDepends])
loadCabalFile String
cabal_filepath = IO (Either String [BuildDepends])
-> IO (Either String [BuildDepends])
handleIOError forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [BuildDepends]
parseContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
readContent where
  readContent :: IO Text
readContent = String -> IO Text
TIO.readFile String
cabal_filepath
  parseContent :: Text
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [BuildDepends]
parseContent = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser (ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
cabalParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof) String
cabal_filepath
  handleIOError :: IO (Either String [BuildDepends])
-> IO (Either String [BuildDepends])
handleIOError = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle IOException -> IO (Either String [BuildDepends])
h where
    h :: IOException -> IO (Either ErrorMsg [BuildDepends])
    h :: IOException -> IO (Either String [BuildDepends])
h = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

isLineSpace :: Char -> Bool
isLineSpace :: Char -> Bool
isLineSpace Char
' ' = Bool
True
isLineSpace Char
'\t' = Bool
True
isLineSpace Char
_ = Bool
False

isOpenBrace :: Char -> Bool
isOpenBrace :: Char -> Bool
isOpenBrace = (forall a. Eq a => a -> a -> Bool
== Char
'{')

isCloseBrace :: Char -> Bool
isCloseBrace :: Char -> Bool
isCloseBrace = (forall a. Eq a => a -> a -> Bool
== Char
'}')

isBrace :: Char -> Bool
isBrace :: Char -> Bool
isBrace Char
c = Char -> Bool
isOpenBrace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isCloseBrace Char
c

lengthOf :: (Char -> Bool) -> P.Parser Int
lengthOf :: (Char -> Bool) -> Parser Int
lengthOf Char -> Bool
p = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
p)

indent :: P.Parser Int
indent :: Parser Int
indent = (Char -> Bool) -> Parser Int
lengthOf Char -> Bool
isLineSpace

finishLine :: P.Parser ()
finishLine :: Parser ()
finishLine = forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol

emptyLine :: P.Parser ()
emptyLine :: Parser ()
emptyLine = Parser Int
indent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ()
comment_line forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol) where
  comment_line :: Parser ()
comment_line = (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try forall a b. (a -> b) -> a -> b
$ String -> ParsecT (ErrorFancy Void) Text Identity String
P.string String
"--") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser Char
P.anyChar forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

blockHeadLine :: P.Parser Target
blockHeadLine :: Parser Target
blockHeadLine = Parser Target
target forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (ErrorFancy Void) Text Identity [Token Text]
trail forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
finishLine where
  trail :: ParsecT (ErrorFancy Void) Text Identity [Token Text]
trail = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isLineSpace Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isOpenBrace Token Text
c
  target :: Parser Target
target = Parser Target
target_lib forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Target
target_exe forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Target
target_test forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Target
target_bench
  target_lib :: Parser Target
target_lib = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> ParsecT (ErrorFancy Void) Text Identity String
P.string' String
"library") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Target
TargetLibrary
  target_exe :: Parser Target
target_exe = Text -> Target
TargetExecutable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Text
targetNamed String
"executable"
  target_test :: Parser Target
target_test = Text -> Target
TargetTestSuite forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Text
targetNamed String
"test-suite"
  target_bench :: Parser Target
target_bench = Text -> Target
TargetBenchmark forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Text
targetNamed String
"benchmark"
  targetNamed :: String -> P.Parser Text
  targetNamed :: String -> Parser Text
targetNamed String
target_type = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> ParsecT (ErrorFancy Void) Text Identity String
P.string' String
target_type)
                            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
isLineSpace)
                            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

fieldStart :: Maybe String -- ^ expected field name. If Nothing, it just don't care.
           -> P.Parser (String, Int) -- ^ (lower-case field name, indent level)
fieldStart :: Maybe String -> Parser (String, Int)
fieldStart Maybe String
mexp_name = do
  Int
level <- Parser Int
indent
  String
name <- ParsecT (ErrorFancy Void) Text Identity String
nameParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Int
indent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
':'
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
name, Int
level)
  where
    nameParser :: ParsecT (ErrorFancy Void) Text Identity String
nameParser = case Maybe String
mexp_name of
      Maybe String
Nothing -> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Bool -> Bool
not (Char -> Bool
isLineSpace Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
':')
      Just String
exp_name -> String -> ParsecT (ErrorFancy Void) Text Identity String
P.string' String
exp_name

fieldBlock :: P.Parser (String, Text) -- ^ (lower-case field name, block content)
fieldBlock :: Parser (String, Text)
fieldBlock = Parser (String, Text)
impl where
  impl :: Parser (String, Text)
impl = do
    (String
field_name, Int
level) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try forall a b. (a -> b) -> a -> b
$ do
      [()]
_ <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser ()
emptyLine forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser ()
conditionalLine forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser ()
bracesOnlyLine)
      Maybe String -> Parser (String, Int)
fieldStart forall a. Maybe a
Nothing
    String
field_trail <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser Char
P.anyChar Parser ()
finishLine
    [String]
rest <- Int -> ParsecT (ErrorFancy Void) Text Identity [String]
remainingLines Int
level
    let text_block :: Text
text_block = Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Text
pack (String
field_trail forall a. a -> [a] -> [a]
: [String]
rest)
    forall (m :: * -> *) a. Monad m => a -> m a
return (String
field_name, Text
text_block)
  remainingLines :: Int -> ParsecT (ErrorFancy Void) Text Identity [String]
remainingLines Int
field_indent_level = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> ParsecT (ErrorFancy Void) Text Identity [String]
go [] where
    go :: [String] -> ParsecT (ErrorFancy Void) Text Identity [String]
go [String]
cur_lines = (forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
cur_lines) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [String] -> ParsecT (ErrorFancy Void) Text Identity [String]
foundSomething [String]
cur_lines
    foundSomething :: [String] -> ParsecT (ErrorFancy Void) Text Identity [String]
foundSomething [String]
cur_lines = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser ()
emptyLine
      Int
this_level <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead Parser Int
indent
      if Int
this_level forall a. Ord a => a -> a -> Bool
<= Int
field_indent_level
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
cur_lines
        else do
        Int
_ <- Parser Int
indent
        String
this_line <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser Char
P.anyChar Parser ()
finishLine
        [String] -> ParsecT (ErrorFancy Void) Text Identity [String]
go (String
this_line forall a. a -> [a] -> [a]
: [String]
cur_lines)
  bracesOnlyLine :: Parser ()
bracesOnlyLine = Parser Int
indent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Int
braceAndSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
finishLine
  braceAndSpace :: Parser Int
braceAndSpace = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
isBrace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
indent

buildDependsLine :: P.Parser [PackageName]
buildDependsLine :: Parser [Text]
buildDependsLine = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text
pname forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`P.endBy` Parser ()
ignored) where
  pname :: Parser Text
pname = String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
allowedChar)
  allowedChar :: Char -> Bool
allowedChar Char
'-' = Bool
True
  allowedChar Char
'_' = Bool
True
  allowedChar Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c
  ignored :: Parser ()
ignored = forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser Char
P.anyChar Parser ()
finishItem forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  finishItem :: Parser ()
finishItem = forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
',')

conditionalLine :: P.Parser ()
conditionalLine :: Parser ()
conditionalLine = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ParsecT (ErrorFancy Void) Text Identity [Token Text]
leader forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Parser ()
term String
"if" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
term String
"else") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser Char
P.anyChar Parser ()
finishLine where
  leader :: ParsecT (ErrorFancy Void) Text Identity [Token Text]
leader = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isLineSpace Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isCloseBrace Token Text
c
  term :: String -> P.Parser ()
  term :: String -> Parser ()
term String
t = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> ParsecT (ErrorFancy Void) Text Identity String
P.string' String
t forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead Parser ()
term_sep)
  term_sep :: Parser ()
term_sep = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isSpace Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isBrace Token Text
c

targetBlock :: P.Parser BuildDepends
targetBlock :: Parser BuildDepends
targetBlock = do
  Target
target <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser Target
blockHeadLine
  [(String, Text)]
fields <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (String, Text)
fieldBlock
  let build_deps_blocks :: [Text]
build_deps_blocks = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((String
"build-depends" forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(String, Text)]
fields
  [Text]
packages <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
build_deps_blocks forall a b. (a -> b) -> a -> b
$ \Text
block -> do
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser (Parser [Text]
buildDependsLine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof) String
"build-depends" Text
block
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BuildDepends { depsTarget :: Target
depsTarget = Target
target,
                          depsPackages :: [Text]
depsPackages = [Text]
packages
                        }

cabalParser :: P.Parser [BuildDepends]
cabalParser :: ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
cabalParser = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
go [] where
  go :: [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
go [BuildDepends]
cur_deps = [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
targetBlockParsed [BuildDepends]
cur_deps forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [BuildDepends]
cur_deps) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
ignoreLine [BuildDepends]
cur_deps
  targetBlockParsed :: [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
targetBlockParsed [BuildDepends]
cur_deps = do
    BuildDepends
new_dep <- Parser BuildDepends
targetBlock
    [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
go (BuildDepends
new_dep forall a. a -> [a] -> [a]
: [BuildDepends]
cur_deps)
  ignoreLine :: [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
ignoreLine [BuildDepends]
cur_deps = forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser Char
P.anyChar Parser ()
finishLine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity [BuildDepends]
go [BuildDepends]
cur_deps