--------------------------------------------------------------------------------
-- |
-- 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 :: forall a. Read a => Int -> ReadS [(a, Int)]
readsMembers = forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S forall a. Read a => ReadPrec [(a, Int)]
readMembersPrec

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

    rest :: Bool -> ReadPrec [(a, Int)]
rest Bool
started = do
      Punc String
c <- ReadPrec Lexeme
lexP
      case String
c of
        String
"}"           -> forall (m :: * -> *) a. Monad m => a -> m a
return []
        String
"," | Bool
started -> ReadPrec [(a, Int)]
next
        String
_             -> forall a. ReadPrec a
pfail

    next :: ReadPrec [(a, Int)]
next = do
      (a, Int)
mem  <- ReadPrec (a, Int)
single forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec (a, Int)
multi
      [(a, Int)]
mems <- Bool -> ReadPrec [(a, Int)]
rest Bool
True
      forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Int)
mem forall a. a -> [a] -> [a]
: [(a, Int)]
mems)

    -- parse a member with implicit multiplicity 1
    single :: ReadPrec (a, Int)
single = do
      a
x <- forall a. ReadPrec a -> ReadPrec a
reset ReadPrec a
readx
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, Int
1)

    -- parse a member with explicit multiplicity
    multi :: ReadPrec (a, Int)
multi = do
      a
x <- forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
11 ReadPrec a
readx
      Int
n <- forall a. ReadPrec a -> ReadPrec a
paren ReadPrec Int
readn
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, Int
n)

    readx :: ReadPrec a
readx = forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec forall a. Read a => Int -> ReadS a
readsPrec
    readn :: ReadPrec Int
readn = forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec forall a. Read a => Int -> ReadS a
readsPrec

paren :: ReadPrec a -> ReadPrec a
paren :: forall a. ReadPrec a -> ReadPrec a
paren ReadPrec a
readx = do
  Punc String
"(" <- ReadPrec Lexeme
lexP
  a
x <- forall a. ReadPrec a -> ReadPrec a
reset ReadPrec a
readx
  Punc String
")" <- ReadPrec Lexeme
lexP
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

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