module Bookhound.Parsers.Collections (collOf, listOf, tupleOf, mapOf) where

import Bookhound.Parser            (Parser, satisfy, withErrorN)
import Bookhound.ParserCombinators (manySepBy)
import Bookhound.Parsers.Char      (closeCurly, closeParens, closeSquare, comma,
                                    openCurly, openParens, openSquare)
import Bookhound.Parsers.Text      (maybeBetweenSpacing)

import           Bookhound.Utils.List (hasMultiple)
import           Data.Map             (Map)
import qualified Data.Map             as Map


collOf :: Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]
collOf :: forall a b c d.
Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]
collOf Parser a
start Parser b
end Parser c
sep Parser d
elemParser =
  Parser a
start forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [d]
elemsParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser b
end
    where
      elemsParser :: Parser [d]
elemsParser = forall a b. Parser a -> Parser b -> Parser [b]
manySepBy Parser c
sep forall a b. (a -> b) -> a -> b
$ forall b. Parser b -> Parser b
maybeBetweenSpacing Parser d
elemParser


listOf :: Parser a -> Parser [a]
listOf :: forall a. Parser a -> Parser [a]
listOf = forall a. Int -> Text -> Parser a -> Parser a
withErrorN (-Int
1) Text
"List"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c d.
Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]
collOf Parser Char
openSquare Parser Char
closeSquare Parser Char
comma


tupleOf :: Parser a -> Parser [a]
tupleOf :: forall a. Parser a -> Parser [a]
tupleOf = forall a. Int -> Text -> Parser a -> Parser a
withErrorN (-Int
1) Text
"Tuple"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Parser a -> Parser a
satisfy forall a. [a] -> Bool
hasMultiple
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c d.
Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]
collOf Parser Char
openParens Parser Char
closeParens Parser Char
comma


mapOf :: Ord b => Parser a -> Parser b -> Parser c -> Parser (Map b c)
mapOf :: forall b a c.
Ord b =>
Parser a -> Parser b -> Parser c -> Parser (Map b c)
mapOf Parser a
sep Parser b
p1 Parser c
p2 = forall a. Int -> Text -> Parser a -> Parser a
withErrorN (-Int
1) Text
"Map" forall a b. (a -> b) -> a -> b
$
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c d.
Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]
collOf Parser Char
openCurly Parser Char
closeCurly Parser Char
comma Parser (b, c)
mapEntry
    where
      mapEntry :: Parser (b, c)
mapEntry = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b
p1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall b. Parser b -> Parser b
maybeBetweenSpacing Parser a
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser c
p2