module Show where
import ConstructorName(constructorNamesAndArities)

pshow :: (ArrowReadShow q,Regular d) => q a () -> q (d a) ()
pshow p = 
  (\f -> (fshowSum (f undefined) p (pshow p) <<< arr out)
         `asTypeOf` arr (const () . f)) constructorNamesAndArities

-- This would be the code if the functor arguments were explicit:
-- pshow<d> p = 
--   fshowSum<FunctorOf d> constructorNamesAndArities<d> p (pshow<d> p) 
--   >>> arr inn<d>

        
polytypic fshowSum :: ArrowReadShow q => [(String,Int)] -> q a () -> q b () -> q (f a b) ()
  = \(s:ss)-> \p r -> case f of 
      g + h   -> fshowSum [s] p r ||| fshowSum ss p r 
      f       -> mayShowParen (prec s) (showSymbol (fst s) <<< fshowProd p r)

polytypic fshowProd :: ArrowReadShow q => q a () -> q b () -> q (f a b) ()
 = \p r -> case f of
      g * h   -> arr (\((),())->()) <<< (fshowProd p r <** fshowProd p r) 
      Empty   -> arr id
      f       -> showSymbol " " <<< setPrec high (fshowRest p r)

polytypic fshowRest:: ArrowReadShow q => q a () -> q b () -> q (f a b) ()
 = \p r -> case f of
      Par     -> p
      Rec     -> r
      d @ g   -> pshow (fshowRest p r)
      
prec :: (String,Int) -> Int
prec p = if snd p == 0 then high else high-1