module ShowReadMapSet where

import Text.Read
import Data.Char (isSpace)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Sequence as Seq


-- Data.Set
{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
instance (Read a, Ord a) => Read (Set.Set a) where
  readsPrec _ = readParen False $ \ r ->
            [(Set.fromList xs,t) | ("{",s) <- lex r
                                 , (xs,t)  <- readl s]
      where readl s  = [([],t)   | ("}",t) <- lex s] ++
                       [(x:xs,u) | (x,t)   <- reads s
                                 , (xs,u)  <- readl' t]
            readl' s = [([],t)   | ("}",t) <- lex s] ++
                       [(x:xs,v) | (",",t) <- lex s
                                 , (x,u)   <- reads t
                                 , (xs,v)  <- readl' u]

-- Data.IntSet
{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
instance Read (IntSet.IntSet) where
  readsPrec _ = readParen False $ \ r ->
            [(IntSet.fromList xs,t)  | ("{",s) <- lex r
                                     , (xs,t)  <- readl s]
      where readl s  = [([],t)   | ("}",t) <- lex s] ++
                       [(x:xs,u) | (x,t)   <- reads s
                                 , (xs,u)  <- readl' t]
            readl' s = [([],t)   | ("}",t) <- lex s] ++
                       [(x:xs,v) | (",",t) <- lex s
                                 , (x,u)   <- reads t
                                 , (xs,v)  <- readl' u]


-- Data.Map
{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
instance (Ord k, Read k, Read e) => Read (Map.Map k e) where
    readsPrec _ = readParen False $ \ r ->
                  [(Map.fromList xs,t) | ("{",s) <- lex r
                                       , (xs,t)  <- readl s]
        where readl s  = [([],t)   | ("}",t) <- lex s] ++
                         [(x:xs,u) | (x,t)   <- readPair s
                                   , (xs,u)  <- readl' t]
              readl' s = [([],t)   | ("}",t) <- lex s] ++
                         [(x:xs,v) | (",",t) <- lex s
                                   , (x,u)   <- readPair t
                                   , (xs,v)  <- readl' u]

-- parses a pair of things with the syntax a:=b
readPair :: (Read a, Read b) => ReadS (a,b)
readPair s = do (a, ct1)    <- reads s
                -- we cannot use lex to parse ":=" 
                -- because for "Foo:=-2" the ":=-" would be lexed together
                ((), ct2)   <- skipSpaces readcolonequal ct1 
                (b, ct3)    <- reads ct2
                return ((a,b), ct3)
    where readcolonequal (':':'=':xs) = [((),xs)] 
          readcolonequal _ = []

skipSpaces :: ReadS () -> ReadS ()
skipSpaces parser (c:xs) | isSpace c  = skipSpaces parser xs
skipSpaces parser s                   = parser s

-- Data.Sequence

{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
-- for "<" and ">" we cannot use lex because for example "<-" are lexed together.
instance (Read a) => Read (Seq.Seq a) where
  readsPrec _ = readParen False $ \ r ->
            [(Seq.fromList xs,t) | ((),s)  <- skipSpaces readLT r
                                 , (xs,t)  <- readl s]
      where readl s  = [([],t)   | ((),t)  <- skipSpaces readGT s] ++
                       [(x:xs,u) | (x,t)   <- reads s
                                 , (xs,u)  <- readl' t]
            readl' s = [([],t)   | ((),t)  <- skipSpaces readGT s] ++
                       [(x:xs,v) | (",",t) <- lex s
                                 , (x,u)   <- reads t
                                 , (xs,v)  <- readl' u]
            readLT ('<':xs) = [((),xs)] 
            readLT _        = []
            readGT ('>':xs) = [((),xs)] 
            readGT _        = []