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

import Bookhound.Parser            (Parser, withError)
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 = forall a. String -> Parser a -> Parser a
withError String
"Collection"
  forall a b. (a -> b) -> a -> b
$ 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. String -> Parser a -> Parser a
withError 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. String -> Parser a -> Parser a
withError 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. String -> Parser a -> Parser a
withError 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