{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Hie.Cabal.Parser where

import Control.Applicative
import Control.Monad
import Data.Attoparsec.Text
import Data.Char
import Data.Functor
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import System.FilePath.Posix ((</>))

type Name = Text

type Path = Text

type Indent = Int

data Package = Package Name [Component]
  deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show, Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq, Eq Package
Eq Package
-> (Package -> Package -> Ordering)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Package)
-> (Package -> Package -> Package)
-> Ord Package
Package -> Package -> Bool
Package -> Package -> Ordering
Package -> Package -> Package
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 :: Package -> Package -> Package
$cmin :: Package -> Package -> Package
max :: Package -> Package -> Package
$cmax :: Package -> Package -> Package
>= :: Package -> Package -> Bool
$c>= :: Package -> Package -> Bool
> :: Package -> Package -> Bool
$c> :: Package -> Package -> Bool
<= :: Package -> Package -> Bool
$c<= :: Package -> Package -> Bool
< :: Package -> Package -> Bool
$c< :: Package -> Package -> Bool
compare :: Package -> Package -> Ordering
$ccompare :: Package -> Package -> Ordering
$cp1Ord :: Eq Package
Ord)

data CompType = Lib | Exe | Test | Bench
  deriving (Int -> CompType -> ShowS
[CompType] -> ShowS
CompType -> String
(Int -> CompType -> ShowS)
-> (CompType -> String) -> ([CompType] -> ShowS) -> Show CompType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompType] -> ShowS
$cshowList :: [CompType] -> ShowS
show :: CompType -> String
$cshow :: CompType -> String
showsPrec :: Int -> CompType -> ShowS
$cshowsPrec :: Int -> CompType -> ShowS
Show, CompType -> CompType -> Bool
(CompType -> CompType -> Bool)
-> (CompType -> CompType -> Bool) -> Eq CompType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompType -> CompType -> Bool
$c/= :: CompType -> CompType -> Bool
== :: CompType -> CompType -> Bool
$c== :: CompType -> CompType -> Bool
Eq, Eq CompType
Eq CompType
-> (CompType -> CompType -> Ordering)
-> (CompType -> CompType -> Bool)
-> (CompType -> CompType -> Bool)
-> (CompType -> CompType -> Bool)
-> (CompType -> CompType -> Bool)
-> (CompType -> CompType -> CompType)
-> (CompType -> CompType -> CompType)
-> Ord CompType
CompType -> CompType -> Bool
CompType -> CompType -> Ordering
CompType -> CompType -> CompType
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 :: CompType -> CompType -> CompType
$cmin :: CompType -> CompType -> CompType
max :: CompType -> CompType -> CompType
$cmax :: CompType -> CompType -> CompType
>= :: CompType -> CompType -> Bool
$c>= :: CompType -> CompType -> Bool
> :: CompType -> CompType -> Bool
$c> :: CompType -> CompType -> Bool
<= :: CompType -> CompType -> Bool
$c<= :: CompType -> CompType -> Bool
< :: CompType -> CompType -> Bool
$c< :: CompType -> CompType -> Bool
compare :: CompType -> CompType -> Ordering
$ccompare :: CompType -> CompType -> Ordering
$cp1Ord :: Eq CompType
Ord)

data Component
  = Comp CompType Name Path
  deriving (Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show, Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
Eq, Eq Component
Eq Component
-> (Component -> Component -> Ordering)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Component)
-> (Component -> Component -> Component)
-> Ord Component
Component -> Component -> Bool
Component -> Component -> Ordering
Component -> Component -> Component
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 :: Component -> Component -> Component
$cmin :: Component -> Component -> Component
max :: Component -> Component -> Component
$cmax :: Component -> Component -> Component
>= :: Component -> Component -> Bool
$c>= :: Component -> Component -> Bool
> :: Component -> Component -> Bool
$c> :: Component -> Component -> Bool
<= :: Component -> Component -> Bool
$c<= :: Component -> Component -> Bool
< :: Component -> Component -> Bool
$c< :: Component -> Component -> Bool
compare :: Component -> Component -> Ordering
$ccompare :: Component -> Component -> Ordering
$cp1Ord :: Eq Component
Ord)

parsePackage' :: Text -> Either String Package
parsePackage' :: Text -> Either String Package
parsePackage' = Parser Package -> Text -> Either String Package
forall a. Parser a -> Text -> Either String a
parseOnly Parser Package
parsePackage

parsePackage :: Parser Package
parsePackage :: Parser Package
parsePackage =
  ( do
      Text
n <- Int -> Text -> (Int -> Parser Text) -> Parser Text
forall a. Int -> Text -> (Int -> Parser a) -> Parser a
field Int
0 Text
"name" ((Int -> Parser Text) -> Parser Text)
-> (Int -> Parser Text) -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser Text -> Int -> Parser Text
forall a b. a -> b -> a
const Parser Text
parseString
      (Package Text
_ [Component]
t) <- Parser Package
parsePackage
      Package -> Parser Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> Parser Package) -> Package -> Parser Package
forall a b. (a -> b) -> a -> b
$ Text -> [Component] -> Package
Package Text
n [Component]
t
  )
    Parser Package -> Parser Package -> Parser Package
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
            [Component]
h <- Int -> Parser [Component]
parseComponent Int
0
            (Package Text
n [Component]
t) <- Parser Package
parsePackage
            Package -> Parser Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> Parser Package) -> Package -> Parser Package
forall a b. (a -> b) -> a -> b
$ Text -> [Component] -> Package
Package Text
n ([Component]
h [Component] -> [Component] -> [Component]
forall a. Semigroup a => a -> a -> a
<> [Component]
t)
        )
    Parser Package -> Parser Package -> Parser Package
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
skipToNextLine Parser () -> Parser Package -> Parser Package
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Package
parsePackage)
    Parser Package -> Parser Package -> Parser Package
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Package -> Parser Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Component] -> Package
Package Text
"" [])

componentHeader :: Indent -> Text -> Parser Name
componentHeader :: Int -> Text -> Parser Text
componentHeader Int
i Text
t = do
  Int
_ <- Int -> Parser Int
indent Int
i
  Text
_ <- Text -> Parser Text
asciiCI Text
t
  Parser Text Char -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser Text Char
tabOrSpace
  Text
n <- Parser Text
parseString Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
  Parser ()
skipToNextLine
  Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n

parseComponent :: Indent -> Parser [Component]
parseComponent :: Int -> Parser [Component]
parseComponent Int
i =
  Int -> Parser [Component]
parseExe Int
i
    Parser [Component] -> Parser [Component] -> Parser [Component]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser [Component]
parseLib Int
i
    Parser [Component] -> Parser [Component] -> Parser [Component]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser [Component]
parseBench Int
i
    Parser [Component] -> Parser [Component] -> Parser [Component]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser [Component]
parseTestSuite Int
i

parseLib :: Indent -> Parser [Component]
parseLib :: Int -> Parser [Component]
parseLib Int
i = Int -> Text -> (Text -> Text -> Component) -> Parser [Component]
parseSec Int
i Text
"library" ((Text -> Text -> Component) -> Parser [Component])
-> (Text -> Text -> Component) -> Parser [Component]
forall a b. (a -> b) -> a -> b
$ CompType -> Text -> Text -> Component
Comp CompType
Lib

parseTestSuite :: Indent -> Parser [Component]
parseTestSuite :: Int -> Parser [Component]
parseTestSuite Int
i = Int -> Text -> (Text -> Text -> Component) -> Parser [Component]
parseSec Int
i Text
"test-suite" ((Text -> Text -> Component) -> Parser [Component])
-> (Text -> Text -> Component) -> Parser [Component]
forall a b. (a -> b) -> a -> b
$ CompType -> Text -> Text -> Component
Comp CompType
Test

parseExe :: Indent -> Parser [Component]
parseExe :: Int -> Parser [Component]
parseExe = (Text -> Text -> Component) -> Text -> Int -> Parser [Component]
parseSecMain (CompType -> Text -> Text -> Component
Comp CompType
Exe) Text
"executable"

parseBench :: Indent -> Parser [Component]
parseBench :: Int -> Parser [Component]
parseBench = (Text -> Text -> Component) -> Text -> Int -> Parser [Component]
parseSecMain (CompType -> Text -> Text -> Component
Comp CompType
Bench) Text
"benchmark"

parseSecMain :: (Name -> Path -> Component) -> Text -> Indent -> Parser [Component]
parseSecMain :: (Text -> Text -> Component) -> Text -> Int -> Parser [Component]
parseSecMain Text -> Text -> Component
c Text
s Int
i = do
  Text
n <- Int -> Text -> Parser Text
componentHeader Int
i Text
s
  [Text]
p <- Int -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Text
"./"] Text
"" [] []
  [Component] -> Parser [Component]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Component] -> Parser [Component])
-> [Component] -> Parser [Component]
forall a b. (a -> b) -> a -> b
$ (Text -> Component) -> [Text] -> [Component]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Component
c Text
n) [Text]
p

parseQuoted :: Parser Text
parseQuoted :: Parser Text
parseQuoted = do
  Char
q <- Char -> Parser Text Char
char Char
'"' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text Char
char Char
'\''
  Text
s <- (Char -> Bool) -> Parser Text
takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
q)
  Char
_ <- Char -> Parser Text Char
char Char
q
  Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s

parseString :: Parser Name
parseString :: Parser Text
parseString = Parser Text
parseQuoted Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
unqualName

unqualName :: Parser Text
unqualName :: Parser Text
unqualName = (Char -> Bool) -> Parser Text
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
','))

-- | Skip spaces and if end of line is reached, skip it as well and require that
-- next one starts with indent.
--
-- Used for parsing fields.
optSkipToNextLine :: Indent -> Parser ()
optSkipToNextLine :: Int -> Parser ()
optSkipToNextLine Int
i = do
  Parser Text Char -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Parser Text Char -> Parser ()) -> Parser Text Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Char
satisfy (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isEndOfLine Char
c))
  Parser Text -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser () -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text
"--" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser Text
takeTill Char -> Bool
isEndOfLine
  Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser ()) -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Char
c
      | Char -> Bool
isEndOfLine Char
c ->
        Parser ()
endOfLine Parser () -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Int
indent Int
i Parser Int -> () -> Parser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
    Maybe Char
_ -> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Comma or space separated list, with optional new lines.
parseList :: Indent -> Parser [Text]
parseList :: Int -> Parser [Text]
parseList Int
i = Parser Text -> Parser () -> Parser [Text]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser Text
parseString (Int -> Parser ()
optSkipToNextLine Int
i Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Char -> Parser Text Char
char Char
',') Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser ()
optSkipToNextLine Int
i)

pathMain :: Indent -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain :: Int -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain Int
i [Text]
p Text
m [Text]
o [Text]
a =
  (Int -> Parser [Text]
hsSourceDir Int
i Parser [Text] -> ([Text] -> Parser [Text]) -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[Text]
p' -> Int -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain Int
i [Text]
p' Text
m [Text]
o [Text]
a))
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Text -> (Int -> Parser Text) -> Parser Text
forall a. Int -> Text -> (Int -> Parser a) -> Parser a
field Int
i Text
"main-is" (Parser Text -> Int -> Parser Text
forall a b. a -> b -> a
const Parser Text
parseString) Parser Text -> (Text -> Parser [Text]) -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Text
m' -> Int -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain Int
i [Text]
p Text
m' [Text]
o [Text]
a))
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Text -> (Int -> Parser [Text]) -> Parser [Text]
forall a. Int -> Text -> (Int -> Parser a) -> Parser a
field Int
i Text
"other-modules" Int -> Parser [Text]
parseList Parser [Text] -> ([Text] -> Parser [Text]) -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Text] -> [Text] -> Parser [Text])
-> [Text] -> [Text] -> Parser [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain Int
i [Text]
p Text
m) [Text]
a)
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Text -> (Int -> Parser [Text]) -> Parser [Text]
forall a. Int -> Text -> (Int -> Parser a) -> Parser a
field Int
i Text
"autogen-modules" Int -> Parser [Text]
parseList Parser [Text] -> ([Text] -> Parser [Text]) -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain Int
i [Text]
p Text
m [Text]
o)
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Parser ()
skipBlockLine Int
i Parser () -> Parser [Text] -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Text] -> Text -> [Text] -> [Text] -> Parser [Text]
pathMain Int
i [Text]
p Text
m [Text]
o [Text]
a)
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> Parser [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
<//> Text
m) [Text]
p
          [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
p' Text -> Text -> Text
<//> (Text
o'' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".hs")
               | Text
p' <- [Text]
p,
                 Text
o' <- (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
a) [Text]
o,
                 let o'' :: Text
o'' = Text -> Text -> Text -> Text
T.replace Text
"." Text
"/" Text
o'
             ]
      )

(<//>) :: Text -> Text -> Text
Text
a <//> :: Text -> Text -> Text
<//> Text
b = String -> Text
T.pack (Text -> String
T.unpack Text
a String -> ShowS
</> Text -> String
T.unpack Text
b)

infixr 5 <//>

parseSec :: Indent -> Text -> (Name -> Path -> Component) -> Parser [Component]
parseSec :: Int -> Text -> (Text -> Text -> Component) -> Parser [Component]
parseSec Int
i Text
compType Text -> Text -> Component
compCon = do
  Text
n <- Int -> Text -> Parser Text
componentHeader Int
i Text
compType
  [Text]
p <- Int -> [Text] -> Parser [Text]
extractPath (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) []
  let p' :: [Text]
p' = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
p then [Text
"./"] else [Text]
p
  [Component] -> Parser [Component]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Component] -> Parser [Component])
-> [Component] -> Parser [Component]
forall a b. (a -> b) -> a -> b
$ (Text -> Component) -> [Text] -> [Component]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Component
compCon Text
n) [Text]
p'

skipToNextLine :: Parser ()
skipToNextLine :: Parser ()
skipToNextLine = (Char -> Bool) -> Parser ()
skipWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine) Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
endOfLine

skipBlock :: Indent -> Parser ()
skipBlock :: Int -> Parser ()
skipBlock Int
i = Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Int -> Parser ()
skipBlockLine Int
i

comment :: Parser ()
comment :: Parser ()
comment = Parser Text Char -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser Text Char
tabOrSpace Parser () -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text
"--" Parser Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipToNextLine

skipBlockLine :: Indent -> Parser ()
skipBlockLine :: Int -> Parser ()
skipBlockLine Int
i = (Int -> Parser Int
indent Int
i Parser Int -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipToNextLine) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
emptyOrComLine

emptyOrComLine :: Parser ()
emptyOrComLine :: Parser ()
emptyOrComLine = Parser Text Char -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser Text Char
tabOrSpace Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
endOfLine Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
comment

tabOrSpace :: Parser Char
tabOrSpace :: Parser Text Char
tabOrSpace = Char -> Parser Text Char
char Char
' ' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text Char
char Char
'\t'

hsSourceDir :: Indent -> Parser [Text]
hsSourceDir :: Int -> Parser [Text]
hsSourceDir Int
i = Int -> Text -> (Int -> Parser [Text]) -> Parser [Text]
forall a. Int -> Text -> (Int -> Parser a) -> Parser a
field Int
i Text
"hs-source-dirs" Int -> Parser [Text]
parseList

-- field :: Indent -> Text -> Parser Text
field ::
  Indent ->
  Text ->
  (Indent -> Parser a) ->
  Parser a
field :: Int -> Text -> (Int -> Parser a) -> Parser a
field Int
i Text
f Int -> Parser a
p =
  do
    Int
i' <- Int -> Parser Int
indent Int
i
    Text
_ <- Text -> Parser Text
asciiCI Text
f
    Parser ()
skipSpace
    Char
_ <- Char -> Parser Text Char
char Char
':'
    Parser ()
skipSpace
    a
p' <- Int -> Parser a
p (Int -> Parser a) -> Int -> Parser a
forall a b. (a -> b) -> a -> b
$ Int
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    Parser ()
skipToNextLine
    a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
p'

extractPath :: Indent -> [Path] -> Parser [Path]
extractPath :: Int -> [Text] -> Parser [Text]
extractPath Int
i [Text]
ps =
  (Int -> Text -> (Int -> Parser [Text]) -> Parser [Text]
forall a. Int -> Text -> (Int -> Parser a) -> Parser a
field Int
i Text
"hs-source-dirs" Int -> Parser [Text]
parseList Parser [Text] -> ([Text] -> Parser [Text]) -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[Text]
p -> Int -> [Text] -> Parser [Text]
extractPath Int
i ([Text] -> Parser [Text]) -> [Text] -> Parser [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
ps [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
p))
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Parser ()
skipBlockLine Int
i Parser () -> Parser [Text] -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Text] -> Parser [Text]
extractPath Int
i [Text]
ps)
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
comment Parser () -> Parser [Text] -> Parser [Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Text] -> Parser [Text]
extractPath Int
i [Text]
ps)
    Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> Parser [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ps

-- | Skip at least n spaces
indent :: Indent -> Parser Int
indent :: Int -> Parser Int
indent Int
i = do
  Int
c <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Parser Text String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
tabOrSpace
  if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i then Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
c else String -> Parser Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"insufficient indent"

extractPkgs :: Parser [T.Text]
extractPkgs :: Parser [Text]
extractPkgs = [[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Text]] -> [Text])
-> ([Maybe [Text]] -> [[Text]]) -> [Maybe [Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Text]] -> [[Text]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Text]] -> [Text])
-> Parser Text [Maybe [Text]] -> Parser [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe [Text]) -> Parser Text [Maybe [Text]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> Parser [Text] -> Parser Text (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> (Int -> Parser [Text]) -> Parser [Text]
forall a. Int -> Text -> (Int -> Parser a) -> Parser a
field Int
0 Text
"packages" Int -> Parser [Text]
parseList Parser Text (Maybe [Text])
-> Parser Text (Maybe [Text]) -> Parser Text (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
skipToNextLine Parser ()
-> Parser Text (Maybe [Text]) -> Parser Text (Maybe [Text])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [Text] -> Parser Text (Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Text]
forall a. Maybe a
Nothing))