module TDisplay.Output.Tags where

import TDisplay
import Data.List
import System.IO.Unsafe

{- |
   The TDisplayTags object shows the TDTag for each TDOutput item.
   This display output is for configuration\/debug purposes and is
   primarily used to obtain the set of tags rather than actual output.

   It is implemented via unsafePerformIO to avoid requiring render to
   be a Monad.

   The \"done\" value of TDisplayTags is used to cause Haskell to
   evaluate the rendering method, as well as providing the return
   status from renderComplete.

   -}


data TDisplayTags = TDTags { done::Bool }

instance Show TDisplayTags where
   show d = if done d then "" else "<TDisplayTags output incomplete>"


instance TDisplay TDisplayTags where
    render e _ = unsafePerformIO $ mapM_ (render' "") e >> return (TDTags True)
        where render' p (TDString (TDTag t f) _s) = putTagInfo p t f
              render' p (TDAtom (TDTag t f))      = putTagInfo p t f
              render' p (TDGroup (TDTag t f) (Left  g))  = putTagInfo p t f >> subrender p g
              render' p (TDGroup (TDTag t f) (Right gs)) = putTagInfo p t f >> subrender p (gs [])
              render' p (TDHsepGroup (TDTag t f) (Left g))   = putTagInfo p t f >> (subrender p $ i_sep $ nosep g)
              render' p (TDHsepGroup (TDTag t f) (Right gs)) = putTagInfo p t f >> (subrender p $ i_sep $ nosep $ gs [])
              render' p (TDVsepGroup (TDTag t f) (Left g))   = putTagInfo p t f >> (subrender p $ i_eol $ noeol g)
              render' p (TDVsepGroup (TDTag t f) (Right gs)) = putTagInfo p t f >> (subrender p $ i_eol $ noeol $ gs [])
              putTagInfo p t f = putStrLn $ taginfo p t f
              taginfo p t f = showString p $ showString t $ show f
              subrender p = mapM_ (render' (p++"  "))
              nosep = filter ((/=) (TDAtom tdTag_sep))
              noeol = filter ((/=) (TDAtom tdTag_EOL))
              i_sep = intersperse (head tdSep)
              i_eol = intersperse (head tdEOL)
    renderComplete = done


{- |
   runTDisplayIO is used to perform the necessary rendering in an IO
   Monad (e.g. main).  It will render its argument until the display
   object returns true (for TDisplayTags, this is usually a single
   rendering pass), and then output a completion message.

   The completion message is usually the empty string, indicating that
   the rendering has completed, but it may be an incomplete message if
   the renderComplete does not return true.  The TDisplayTags does
   not require complex, multi-pass rendering, but the variable result
   value causes Haskell to perform the rendering call to determine the
   value to pass (via show) to the final putStr IO monad operation,
   thereby ensuring the render occurs.
   -}

runTDisplayIO :: [TDOutput] -> IO ()
runTDisplayIO x = return (until renderComplete (render x) (TDTags False)) >>= putStrLn . show