{-# 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
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"," ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ [Maybe Builder] -> [Builder]
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"
]) Builder -> Builder -> Builder
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 = Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
disp
| Bool
otherwise = Maybe Builder
forall a. Maybe a
Nothing
$(deriveTextShow fdKeyTypeName)
instance TextShow $(conT uniqueTypeName) where
showb :: Unique -> Builder
showb = Int -> Builder
forall a. TextShow a => a -> Builder
showb (Int -> Builder) -> (Unique -> Int) -> Unique -> Builder
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