{-# LANGUAGE CPP #-}
module ShowCommandF(showCommandF) where
import CompOps((>.=<), (>=.<))
import Fudget
--import Geometry(Line, Point, Rect, Size(..))
--import LayoutRequest(LayoutRequest)
--import Message(Message)
import Path(showPath)
import Debug.Trace(trace)
import Xtypes
import Command
import Event
--import ResourceIds
import Sockets
import CmdLineEnv(argFlag)
--import DialogueIO hiding (IOError)

showCommandF :: String -> (F a b) -> F a b
showCommandF :: forall a b. String -> F a b -> F a b
showCommandF String
s F a b
f = forall a b. a -> b -> a
const (if Bool -> Bool
not (String -> Bool -> Bool
argFlag String
s Bool
False) then F a b
f else
    let showit :: (b -> String) -> String -> (Path, b) -> (Path, b)
showit b -> String
show' String
d (Path
t, b
c) =
            forall a. String -> a -> a
trace (String
s forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
d forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ Path -> String
showPath Path
t forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ b -> String
show' b
c
#ifdef __NHC__
		   ++ "\n"
#endif
		   )
                  (Path
t, b
c)
    in  (forall {b}. (b -> String) -> String -> (Path, b) -> (Path, b)
showit forall a. Show a => a -> String
show String
"out" forall {hi} {ho}. (TCommand -> TCommand) -> F hi ho -> F hi ho
>.=< F a b
f) forall {hi} {ho}. F hi ho -> (TEvent -> TEvent) -> F hi ho
>=.< forall {b}. (b -> String) -> String -> (Path, b) -> (Path, b)
showit forall a. Show a => a -> String
show String
"in") [String]
x

{-
showEv e = case e of
       IOResponse (XResponse x) -> "IOResponse (XResponse ..."++show x++")"
       _ -> show e
-}

-- Hack: The following is to avoid show methods from hlib

x :: [String]
x = [forall a. Show a => a -> String
show (forall {a}. a
m :: Display),
     forall a. Show a => a -> String
show (forall {a}. a
m :: Command),
     forall a. Show a => a -> String
show (forall {a}. a
m :: Event),
     forall a. Show a => a -> String
show (forall {a}. a
m :: WindowId),
     forall a. Show a => a -> String
show (forall {a}. a
m :: Descriptor)]

m :: a
m = forall a. HasCallStack => String -> a
error String
"module ShowCommandF"