{-# LANGUAGE FlexibleInstances #-}
module FlatBuffers.Internal.Compiler.Display where
import Data.Int
import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Data.Word
class Display a where
display :: a -> String
instance {-# OVERLAPPING #-} Display String where
display :: String -> String
display = String -> String
forall a. a -> a
id
instance Display T.Text where
display :: Text -> String
display = Text -> String
T.unpack
instance Display a => Display (NonEmpty a) where
display :: NonEmpty a -> String
display = [a] -> String
forall a. Display a => a -> String
display ([a] -> String) -> (NonEmpty a -> [a]) -> NonEmpty a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList
instance Display a => Display [a] where
display :: [a] -> String
display [a]
xs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> String
forall a. Display a => a -> String
display [a]
xs)
instance Display Int where display :: Int -> String
display = Int -> String
forall a. Show a => a -> String
show
instance Display Integer where display :: Integer -> String
display = Integer -> String
forall a. Show a => a -> String
show
instance Display Int8 where display :: Int8 -> String
display = Int8 -> String
forall a. Show a => a -> String
show
instance Display Int16 where display :: Int16 -> String
display = Int16 -> String
forall a. Show a => a -> String
show
instance Display Int32 where display :: Int32 -> String
display = Int32 -> String
forall a. Show a => a -> String
show
instance Display Int64 where display :: Int64 -> String
display = Int64 -> String
forall a. Show a => a -> String
show
instance Display Word8 where display :: Word8 -> String
display = Word8 -> String
forall a. Show a => a -> String
show
instance Display Word16 where display :: Word16 -> String
display = Word16 -> String
forall a. Show a => a -> String
show
instance Display Word32 where display :: Word32 -> String
display = Word32 -> String
forall a. Show a => a -> String
show
instance Display Word64 where display :: Word64 -> String
display = Word64 -> String
forall a. Show a => a -> String
show