module Read where
import ConstructorName(constructorNamesAndArities)

pread :: (ArrowReadShow q,Regular d) => q () a -> q () (d a)
pread p = 
  (\z -> (freadSum (constructorNamesAndArities z) p (pread p) >>> arr inn)
         `asTypeOf` arr (const z)) undefined
        
-- This would be the code if the functor arguments were explicit:
-- pread<d> p = 
--   freadSum<FunctorOf d> constructorNamesAndArities<d> p (pread<d> p) 
--   >>> arr inn<d>

polytypic freadSum :: ArrowReadShow q => [(String,Int)] -> q () a -> q () b -> q () (f a b)
  = \(s:ss)-> \p r -> case f of 
      g + h   -> freadSum [s] p r <|> freadSum ss p r 
      f       -> mayReadParen (prec s) 
                              (readSymbol (fst s) >>> freadProd p r)

polytypic freadProd :: ArrowReadShow q => q () a -> q () b -> q () (f a b)
 = \p r -> case f of
      g * h   -> arr (\()->((),())) >>> (freadProd p r **> freadProd p r) 
      Empty   -> arr id
      f       -> readSymbol " " >>> setPrec high (freadRest p r)

polytypic freadRest:: ArrowReadShow q => q () a -> q () b -> q () (f a b)
 = \p r -> case f of
      Par     -> p
      Rec     -> r
      d @ g   -> pread (freadRest p r)
      
prec :: (String,Int) -> Int
prec p = if snd p == 0 then high else high-1
-- If the arity is 0, use high precedence, otherwise lower.