module RS(module RS,module Prec) where
import Prec(Prec,high)
import ArrowTypes(StateArrT(..),MonadArrT(..),Kleisli(..),ReaderArrT)

type Bag = [] -- Could use the module Bags.hs, but the diff is not relevant.
newtype RS a b = RS (ReaderArrT Prec 
                     (StateArrT String 
                      (Kleisli Bag)) a b)

-- Converting RS-arrows:

-- this is almost true:
--   type ShowSPrec a = Prec -> a -> String -> [((),String)]
--   type ReadSPrec b = Prec -> () -> String -> [(b,String)]

-- makeRS and unRS break the abstraction barrier - use with care
makeRS f = RS (MonadArrT f')
  where f' r = StateArrT (Kleisli (f r))

unRS :: RS a b -> Prec -> (a,String) -> [(b,String)]
unRS (RS (MonadArrT g)) = \r-> case g r of StateArrT (Kleisli f) -> f

botRS :: RS a b
botRS = makeRS (error "botRS: you hit the bottom")

--  ShowSPrec conversions
-- type ShowS = String -> String
type ShowSPrec a = Prec -> a -> ShowS
fromRStoS :: RS a () -> ShowSPrec a
fromRStoS r p a s = snd (head (unRS r p (a,s)))

toRSfromS :: ShowSPrec a -> RS a ()
toRSfromS r = makeRS f
  where --f :: Prec -> (a,String) -> [((),String)]
        f p ~(a,s) = [((), r p a s)]

--  ReadSPrec conversions
-- type ReadS a = String -> [(a,String)]
type ReadSPrec a = Prec -> ReadS a
fromRStoR :: RS () a -> ReadSPrec a
fromRStoR r p s = unRS r p ((),s)

toRSfromR :: ReadSPrec a -> RS () a
toRSfromR r = makeRS f
  where --f :: Prec -> ((),String) -> [(a,String)]
        f p ~(~(),s) = r p s