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
)
data Target = TargetLibrary
| TargetExecutable Text
| TargetTestSuite Text
| TargetBenchmark Text
deriving (Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Target -> ShowS
showsPrec :: Int -> Target -> ShowS
$cshow :: Target -> String
show :: Target -> String
$cshowList :: [Target] -> ShowS
showList :: [Target] -> ShowS
Show,Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: Target -> Target -> Bool
Eq,Eq Target
Eq Target =>
(Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord 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
$ccompare :: Target -> Target -> Ordering
compare :: Target -> Target -> Ordering
$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
>= :: Target -> Target -> Bool
$cmax :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
min :: Target -> Target -> Target
Ord)
data BuildDepends =
BuildDepends { BuildDepends -> Target
depsTarget :: Target,
BuildDepends -> [Text]
depsPackages :: [PackageName]
} deriving (Int -> BuildDepends -> ShowS
[BuildDepends] -> ShowS
BuildDepends -> String
(Int -> BuildDepends -> ShowS)
-> (BuildDepends -> String)
-> ([BuildDepends] -> ShowS)
-> Show BuildDepends
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildDepends -> ShowS
showsPrec :: Int -> BuildDepends -> ShowS
$cshow :: BuildDepends -> String
show :: BuildDepends -> String
$cshowList :: [BuildDepends] -> ShowS
showList :: [BuildDepends] -> ShowS
Show,BuildDepends -> BuildDepends -> Bool
(BuildDepends -> BuildDepends -> Bool)
-> (BuildDepends -> BuildDepends -> Bool) -> Eq BuildDepends
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildDepends -> BuildDepends -> Bool
== :: BuildDepends -> BuildDepends -> Bool
$c/= :: BuildDepends -> BuildDepends -> Bool
/= :: BuildDepends -> BuildDepends -> Bool
Eq,Eq BuildDepends
Eq BuildDepends =>
(BuildDepends -> BuildDepends -> Ordering)
-> (BuildDepends -> BuildDepends -> Bool)
-> (BuildDepends -> BuildDepends -> Bool)
-> (BuildDepends -> BuildDepends -> Bool)
-> (BuildDepends -> BuildDepends -> Bool)
-> (BuildDepends -> BuildDepends -> BuildDepends)
-> (BuildDepends -> BuildDepends -> BuildDepends)
-> Ord 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
$ccompare :: BuildDepends -> BuildDepends -> Ordering
compare :: BuildDepends -> BuildDepends -> Ordering
$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
>= :: BuildDepends -> BuildDepends -> Bool
$cmax :: BuildDepends -> BuildDepends -> BuildDepends
max :: BuildDepends -> BuildDepends -> BuildDepends
$cmin :: BuildDepends -> BuildDepends -> BuildDepends
min :: BuildDepends -> BuildDepends -> BuildDepends
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 (IO (Either String [BuildDepends])
-> IO (Either String [BuildDepends]))
-> IO (Either String [BuildDepends])
-> IO (Either String [BuildDepends])
forall a b. (a -> b) -> a -> b
$ (ParseErrorBundle Text (ErrorFancy Void) -> String)
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [BuildDepends]
-> Either String [BuildDepends]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text (ErrorFancy Void) -> String
forall a. Show a => a -> String
show (Either (ParseErrorBundle Text (ErrorFancy Void)) [BuildDepends]
-> Either String [BuildDepends])
-> (Text
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [BuildDepends])
-> Text
-> Either String [BuildDepends]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [BuildDepends]
parseContent (Text -> Either String [BuildDepends])
-> IO Text -> IO (Either String [BuildDepends])
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 = Parsec (ErrorFancy Void) Text [BuildDepends]
-> String
-> Text
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [BuildDepends]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser (Parsec (ErrorFancy Void) Text [BuildDepends]
cabalParser Parsec (ErrorFancy Void) Text [BuildDepends]
-> ParsecT (ErrorFancy Void) Text Identity ()
-> Parsec (ErrorFancy Void) Text [BuildDepends]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof) String
cabal_filepath
handleIOError :: IO (Either String [BuildDepends])
-> IO (Either String [BuildDepends])
handleIOError = (IOException -> IO (Either String [BuildDepends]))
-> IO (Either String [BuildDepends])
-> IO (Either String [BuildDepends])
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 = Either String [BuildDepends] -> IO (Either String [BuildDepends])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [BuildDepends] -> IO (Either String [BuildDepends]))
-> (IOException -> Either String [BuildDepends])
-> IOException
-> IO (Either String [BuildDepends])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String [BuildDepends]
forall a b. a -> Either a b
Left (String -> Either String [BuildDepends])
-> (IOException -> String)
-> IOException
-> Either String [BuildDepends]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
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 = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{')
isCloseBrace :: Char -> Bool
isCloseBrace :: Char -> Bool
isCloseBrace = (Char -> Char -> Bool
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 = [Token Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Token Text] -> Int)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
-> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text])
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token Text -> Bool
p)
indent :: P.Parser Int
indent :: Parser Int
indent = (Char -> Bool) -> Parser Int
lengthOf Char -> Bool
isLineSpace
finishLine :: P.Parser ()
finishLine :: ParsecT (ErrorFancy Void) Text Identity ()
finishLine = ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT (ErrorFancy Void) Text Identity (Tokens Text)
-> ParsecT (ErrorFancy Void) Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT (ErrorFancy Void) Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol
emptyLine :: P.Parser ()
emptyLine :: ParsecT (ErrorFancy Void) Text Identity ()
emptyLine = Parser Int
indent Parser Int
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT (ErrorFancy Void) Text Identity ()
comment_line ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT (ErrorFancy Void) Text Identity (Tokens Text)
-> ParsecT (ErrorFancy Void) Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT (ErrorFancy Void) Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol) where
comment_line :: ParsecT (ErrorFancy Void) Text Identity ()
comment_line = (ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String)
-> ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT (ErrorFancy Void) Text Identity String
P.string String
"--") ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity (Tokens Text)
-> ParsecT (ErrorFancy Void) Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT (ErrorFancy Void) Text Identity Char
P.anyChar ParsecT (ErrorFancy Void) Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
P.eol ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT (ErrorFancy Void) Text Identity ()
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
blockHeadLine :: P.Parser Target
blockHeadLine :: Parser Target
blockHeadLine = Parser Target
target Parser Target
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
-> Parser Target
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (ErrorFancy Void) Text Identity [Token Text]
trail Parser Target
-> ParsecT (ErrorFancy Void) Text Identity () -> Parser Target
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (ErrorFancy Void) Text Identity ()
finishLine where
trail :: ParsecT (ErrorFancy Void) Text Identity [Token Text]
trail = ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text])
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy ((Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text))
-> (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isLineSpace Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isOpenBrace Char
Token Text
c
target :: Parser Target
target = Parser Target
target_lib Parser Target -> Parser Target -> Parser Target
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Target
target_exe Parser Target -> Parser Target -> Parser Target
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Target
target_test Parser Target -> Parser Target -> Parser Target
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Target
target_bench
target_lib :: Parser Target
target_lib = ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
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") ParsecT (ErrorFancy Void) Text Identity String
-> Parser Target -> Parser Target
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Target -> Parser Target
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target
TargetLibrary
target_exe :: Parser Target
target_exe = Text -> Target
TargetExecutable (Text -> Target)
-> ParsecT (ErrorFancy Void) Text Identity Text -> Parser Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT (ErrorFancy Void) Text Identity Text
targetNamed String
"executable"
target_test :: Parser Target
target_test = Text -> Target
TargetTestSuite (Text -> Target)
-> ParsecT (ErrorFancy Void) Text Identity Text -> Parser Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT (ErrorFancy Void) Text Identity Text
targetNamed String
"test-suite"
target_bench :: Parser Target
target_bench = Text -> Target
TargetBenchmark (Text -> Target)
-> ParsecT (ErrorFancy Void) Text Identity Text -> Parser Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT (ErrorFancy Void) Text Identity Text
targetNamed String
"benchmark"
targetNamed :: String -> P.Parser Text
targetNamed :: String -> ParsecT (ErrorFancy Void) Text Identity Text
targetNamed String
target_type = ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
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)
ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text])
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token Text -> Bool
isLineSpace)
ParsecT (ErrorFancy Void) Text Identity [Token Text]
-> ParsecT (ErrorFancy Void) Text Identity Text
-> ParsecT (ErrorFancy Void) Text Identity Text
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((String -> Text)
-> ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity Text
forall a b.
(a -> b)
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack (ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity Text)
-> ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String)
-> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))
fieldStart :: Maybe String
-> P.Parser (String, Int)
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 ParsecT (ErrorFancy Void) Text Identity String
-> Parser Int -> ParsecT (ErrorFancy Void) Text Identity String
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Int
indent ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
':'
(String, Int) -> Parser (String, Int)
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Char) -> ShowS
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 -> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String)
-> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy ((Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text))
-> (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Bool -> Bool
not (Char -> Bool
isLineSpace Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
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)
fieldBlock :: Parser (String, Text)
fieldBlock = Parser (String, Text)
impl where
impl :: Parser (String, Text)
impl = do
(String
field_name, Int
level) <- Parser (String, Int) -> Parser (String, Int)
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Parser (String, Int) -> Parser (String, Int))
-> Parser (String, Int) -> Parser (String, Int)
forall a b. (a -> b) -> a -> b
$ do
[()]
_ <- ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity [()]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity [()])
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity [()]
forall a b. (a -> b) -> a -> b
$ (ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT (ErrorFancy Void) Text Identity ()
emptyLine ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT (ErrorFancy Void) Text Identity ()
conditionalLine ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT (ErrorFancy Void) Text Identity ()
bracesOnlyLine)
Maybe String -> Parser (String, Int)
fieldStart Maybe String
forall a. Maybe a
Nothing
String
field_trail <- ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT (ErrorFancy Void) Text Identity Char
P.anyChar ParsecT (ErrorFancy Void) Text Identity ()
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" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
pack (String
field_trail String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rest)
(String, Text) -> Parser (String, Text)
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
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 = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ParsecT (ErrorFancy Void) Text Identity [String]
-> ParsecT (ErrorFancy Void) Text Identity [String]
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 = (ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity [String]
-> ParsecT (ErrorFancy Void) Text Identity [String]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [String] -> ParsecT (ErrorFancy Void) Text Identity [String]
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
cur_lines) ParsecT (ErrorFancy Void) Text Identity [String]
-> ParsecT (ErrorFancy Void) Text Identity [String]
-> ParsecT (ErrorFancy Void) Text Identity [String]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
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
ParsecT (ErrorFancy Void) Text Identity [()]
-> ParsecT (ErrorFancy Void) Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) Text Identity [()]
-> ParsecT (ErrorFancy Void) Text Identity ())
-> ParsecT (ErrorFancy Void) Text Identity [()]
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity [()]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity [()])
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity [()]
forall a b. (a -> b) -> a -> b
$ ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT (ErrorFancy Void) Text Identity ()
emptyLine
Int
this_level <- Parser Int -> Parser Int
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead Parser Int
indent
if Int
this_level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
field_indent_level
then [String] -> ParsecT (ErrorFancy Void) Text Identity [String]
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
cur_lines
else do
Int
_ <- Parser Int
indent
String
this_line <- ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT (ErrorFancy Void) Text Identity Char
P.anyChar ParsecT (ErrorFancy Void) Text Identity ()
finishLine
[String] -> ParsecT (ErrorFancy Void) Text Identity [String]
go (String
this_line String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
cur_lines)
bracesOnlyLine :: ParsecT (ErrorFancy Void) Text Identity ()
bracesOnlyLine = Parser Int
indent Parser Int
-> ParsecT (ErrorFancy Void) Text Identity [Int]
-> ParsecT (ErrorFancy Void) Text Identity [Int]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int -> ParsecT (ErrorFancy Void) Text Identity [Int]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Int
braceAndSpace ParsecT (ErrorFancy Void) Text Identity [Int]
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (ErrorFancy Void) Text Identity ()
finishLine
braceAndSpace :: Parser Int
braceAndSpace = (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token Text -> Bool
isBrace ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> Parser Int -> Parser Int
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
indent
buildDependsLine :: P.Parser [PackageName]
buildDependsLine :: Parser [Text]
buildDependsLine = ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space ParsecT (ErrorFancy Void) Text Identity ()
-> Parser [Text] -> Parser [Text]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT (ErrorFancy Void) Text Identity Text
pname ParsecT (ErrorFancy Void) Text Identity Text
-> ParsecT (ErrorFancy Void) Text Identity () -> Parser [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`P.endBy` ParsecT (ErrorFancy Void) Text Identity ()
ignored) where
pname :: ParsecT (ErrorFancy Void) Text Identity Text
pname = String -> Text
pack (String -> Text)
-> ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String)
-> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity String
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token Text -> 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 :: ParsecT (ErrorFancy Void) Text Identity ()
ignored = ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT (ErrorFancy Void) Text Identity Char
P.anyChar ParsecT (ErrorFancy Void) Text Identity ()
finishItem ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
finishItem :: ParsecT (ErrorFancy Void) Text Identity ()
finishItem = ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ())
-> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
',')
conditionalLine :: P.Parser ()
conditionalLine :: ParsecT (ErrorFancy Void) Text Identity ()
conditionalLine = ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity ())
-> ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT (ErrorFancy Void) Text Identity [Token Text]
leader ParsecT (ErrorFancy Void) Text Identity [Token Text]
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> ParsecT (ErrorFancy Void) Text Identity ()
term String
"if" ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT (ErrorFancy Void) Text Identity ()
term String
"else") ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity String
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT (ErrorFancy Void) Text Identity Char
P.anyChar ParsecT (ErrorFancy Void) Text Identity ()
finishLine where
leader :: ParsecT (ErrorFancy Void) Text Identity [Token Text]
leader = ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text])
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy ((Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text))
-> (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isLineSpace Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isCloseBrace Char
Token Text
c
term :: String -> P.Parser ()
term :: String -> ParsecT (ErrorFancy Void) Text Identity ()
term String
t = ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
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 ParsecT (ErrorFancy Void) Text Identity String
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ParsecT (ErrorFancy Void) Text Identity ()
term_sep)
term_sep :: ParsecT (ErrorFancy Void) Text Identity ()
term_sep = ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity ())
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
-> ParsecT (ErrorFancy Void) Text Identity ()
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy ((Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text))
-> (Token Text -> Bool)
-> ParsecT (ErrorFancy Void) Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isSpace Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isBrace Char
Token Text
c
targetBlock :: P.Parser BuildDepends
targetBlock :: Parser BuildDepends
targetBlock = do
Target
target <- Parser Target -> Parser Target
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser Target
blockHeadLine
[(String, Text)]
fields <- Parser (String, Text)
-> ParsecT (ErrorFancy Void) Text Identity [(String, Text)]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (String, Text)
fieldBlock
let build_deps_blocks :: [Text]
build_deps_blocks = ((String, Text) -> Text) -> [(String, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String, Text) -> Text
forall a b. (a, b) -> b
snd ([(String, Text)] -> [Text]) -> [(String, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((String, Text) -> Bool) -> [(String, Text)] -> [(String, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
"build-depends" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> ((String, Text) -> String) -> (String, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Text) -> String
forall a b. (a, b) -> a
fst) ([(String, Text)] -> [(String, Text)])
-> [(String, Text)] -> [(String, Text)]
forall a b. (a -> b) -> a -> b
$ [(String, Text)]
fields
[Text]
packages <- ([[Text]] -> [Text])
-> ParsecT (ErrorFancy Void) Text Identity [[Text]]
-> Parser [Text]
forall a b.
(a -> b)
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (ParsecT (ErrorFancy Void) Text Identity [[Text]] -> Parser [Text])
-> ParsecT (ErrorFancy Void) Text Identity [[Text]]
-> Parser [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
-> (Text -> Parser [Text])
-> ParsecT (ErrorFancy Void) Text Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
build_deps_blocks ((Text -> Parser [Text])
-> ParsecT (ErrorFancy Void) Text Identity [[Text]])
-> (Text -> Parser [Text])
-> ParsecT (ErrorFancy Void) Text Identity [[Text]]
forall a b. (a -> b) -> a -> b
$ \Text
block -> do
(ParseErrorBundle Text (ErrorFancy Void) -> Parser [Text])
-> ([Text] -> Parser [Text])
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [Text]
-> Parser [Text]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser [Text]
forall a. String -> ParsecT (ErrorFancy Void) Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser [Text])
-> (ParseErrorBundle Text (ErrorFancy Void) -> String)
-> ParseErrorBundle Text (ErrorFancy Void)
-> Parser [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text (ErrorFancy Void) -> String
forall a. Show a => a -> String
show) [Text] -> Parser [Text]
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseErrorBundle Text (ErrorFancy Void)) [Text]
-> Parser [Text])
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [Text]
-> Parser [Text]
forall a b. (a -> b) -> a -> b
$ Parser [Text]
-> String
-> Text
-> Either (ParseErrorBundle Text (ErrorFancy Void)) [Text]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser (Parser [Text]
buildDependsLine Parser [Text]
-> ParsecT (ErrorFancy Void) Text Identity () -> Parser [Text]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space Parser [Text]
-> ParsecT (ErrorFancy Void) Text Identity () -> Parser [Text]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof) String
"build-depends" Text
block
BuildDepends -> Parser BuildDepends
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildDepends -> Parser BuildDepends)
-> BuildDepends -> Parser BuildDepends
forall a b. (a -> b) -> a -> b
$ BuildDepends { depsTarget :: Target
depsTarget = Target
target,
depsPackages :: [Text]
depsPackages = [Text]
packages
}
cabalParser :: P.Parser [BuildDepends]
cabalParser :: Parsec (ErrorFancy Void) Text [BuildDepends]
cabalParser = [BuildDepends] -> [BuildDepends]
forall a. [a] -> [a]
reverse ([BuildDepends] -> [BuildDepends])
-> Parsec (ErrorFancy Void) Text [BuildDepends]
-> Parsec (ErrorFancy Void) Text [BuildDepends]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
go [] where
go :: [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
go [BuildDepends]
cur_deps = [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
targetBlockParsed [BuildDepends]
cur_deps Parsec (ErrorFancy Void) Text [BuildDepends]
-> Parsec (ErrorFancy Void) Text [BuildDepends]
-> Parsec (ErrorFancy Void) Text [BuildDepends]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT (ErrorFancy Void) Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof ParsecT (ErrorFancy Void) Text Identity ()
-> Parsec (ErrorFancy Void) Text [BuildDepends]
-> Parsec (ErrorFancy Void) Text [BuildDepends]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
forall a. a -> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [BuildDepends]
cur_deps) Parsec (ErrorFancy Void) Text [BuildDepends]
-> Parsec (ErrorFancy Void) Text [BuildDepends]
-> Parsec (ErrorFancy Void) Text [BuildDepends]
forall a.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
ignoreLine [BuildDepends]
cur_deps
targetBlockParsed :: [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
targetBlockParsed [BuildDepends]
cur_deps = do
BuildDepends
new_dep <- Parser BuildDepends
targetBlock
[BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
go (BuildDepends
new_dep BuildDepends -> [BuildDepends] -> [BuildDepends]
forall a. a -> [a] -> [a]
: [BuildDepends]
cur_deps)
ignoreLine :: [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
ignoreLine [BuildDepends]
cur_deps = ParsecT (ErrorFancy Void) Text Identity Char
-> ParsecT (ErrorFancy Void) Text Identity ()
-> ParsecT (ErrorFancy Void) Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT (ErrorFancy Void) Text Identity Char
P.anyChar ParsecT (ErrorFancy Void) Text Identity ()
finishLine ParsecT (ErrorFancy Void) Text Identity String
-> Parsec (ErrorFancy Void) Text [BuildDepends]
-> Parsec (ErrorFancy Void) Text [BuildDepends]
forall a b.
ParsecT (ErrorFancy Void) Text Identity a
-> ParsecT (ErrorFancy Void) Text Identity b
-> ParsecT (ErrorFancy Void) Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [BuildDepends] -> Parsec (ErrorFancy Void) Text [BuildDepends]
go [BuildDepends]
cur_deps