{-# LANGUAGE CPP #-}
#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS)
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#endif
module TextShow.GHC.Event () where
#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS)
import Data.List (intersperse)
import Data.Maybe (catMaybes)
import Data.Text.Lazy.Builder (Builder, singleton)
import GHC.Event (Event, evtRead, evtWrite)
import Language.Haskell.TH.Lib (conT, varE)
import Prelude ()
import Prelude.Compat
import TextShow.Classes (TextShow(..))
import TextShow.Data.Integral ()
import TextShow.System.Posix.Types ()
import TextShow.TH.Internal (deriveTextShow)
import TextShow.TH.Names (evtCloseValName, eventIsValName,
fdKeyTypeName, uniqueTypeName, asInt64ValName)
# if MIN_VERSION_base(4,8,1)
import GHC.Event (Lifetime)
# endif
instance TextShow Event where
showb :: Event -> Builder
showb Event
e = Char -> Builder
singleton Char
'[' forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Builder
"," forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
[ Event
evtRead Event -> Builder -> Maybe Builder
`so` Builder
"evtRead"
, Event
evtWrite Event -> Builder -> Maybe Builder
`so` Builder
"evtWrite"
, $(varE evtCloseValName) Event -> Builder -> Maybe Builder
`so` Builder
"evtClose"
]) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
']'
where
so :: Event -> Builder -> Maybe Builder
Event
ev so :: Event -> Builder -> Maybe Builder
`so` Builder
disp | $(varE eventIsValName) Event
e Event
ev = forall a. a -> Maybe a
Just Builder
disp
| Bool
otherwise = forall a. Maybe a
Nothing
$(deriveTextShow fdKeyTypeName)
instance TextShow $(conT uniqueTypeName) where
showb :: Unique -> Builder
showb = forall a. TextShow a => a -> Builder
showb forall b c a. (b -> c) -> (a -> b) -> a -> c
. $(varE asInt64ValName)
{-# INLINE showb #-}
# if MIN_VERSION_base(4,8,1)
$(deriveTextShow ''Lifetime)
# endif
#endif