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

import Bookhound.Parser            (Parser, withErrorN)
import Bookhound.ParserCombinators (anySepBy, maybeWithin, satisfies)
import Bookhound.Parsers.Char      (closeCurly, closeParens, closeSquare, comma,
                                    openCurly, openParens, openSquare)
import Bookhound.Parsers.String    (spacing)

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]
anySepBy Parser c
sep forall a b. (a -> b) -> a -> b
$ forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing Parser d
elemParser


listOf :: Parser a -> Parser [a]
listOf :: forall a. Parser a -> Parser [a]
listOf = forall a. Int -> String -> Parser a -> Parser a
withErrorN (-Int
1) String
"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 -> String -> Parser a -> Parser a
withErrorN (-Int
1) String
"Tuple"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Parser a -> Parser a
satisfies ((forall a. Ord a => a -> a -> Bool
>= Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
  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 -> String -> Parser a -> Parser a
withErrorN (-Int
1) String
"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 a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing Parser a
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser c
p2