--------------------------------------------------------------------------------
-- |
-- Module      :  Data.SignedMultiset.Read
-- Copyright   :  (c) 2012 Stefan Holdermans
-- License     :  BSD-style
-- Maintainer  :  stefan@vectorfabrics.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Parsing utilities for signed multisets.
--
--------------------------------------------------------------------------------

module Data.SignedMultiset.Read (

  readsMembers,  -- :: Read a => Int -> ReadS [(a, Int)]
  mapReadS       -- :: (a -> b) -> ReadS a -> ReadS b

) where

import Text.Read

readsMembers :: Read a => Int -> ReadS [(a, Int)]
readsMembers = readPrec_to_S readMembersPrec

readMembersPrec :: Read a => ReadPrec [(a, Int)]
readMembersPrec = parens first
  where
    first = do
      Punc "{" <- lexP
      rest False +++ next

    rest started = do
      Punc c <- lexP
      case c of
        "}"           -> return []
        "," | started -> next
        _             -> pfail

    next = do
      mem  <- single +++ multi
      mems <- rest True
      return (mem : mems)

    -- parse a member with implicit multiplicity 1
    single = do
      x <- reset readx
      return (x, 1)

    -- parse a member with explicit multiplicity
    multi = do
      x <- prec 11 readx
      n <- paren readn
      return (x, n)

    readx = readS_to_Prec readsPrec
    readn = readS_to_Prec readsPrec

paren :: ReadPrec a -> ReadPrec a
paren readx = do
  Punc "(" <- lexP
  x <- reset readx
  Punc ")" <- lexP
  return x

mapReadS :: (a -> b) -> ReadS a -> ReadS b
mapReadS f readx n = [(f x, rest) | (x, rest) <- readx n]