{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{- | Utilities for showing string-like things. -}
module OM.Show (
  showt,
  showj,
  ShowJ(..),
) where


import Data.Aeson (encode, ToJSON)
import Data.String (IsString, fromString)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE


{- | Like 'show', but for any string-like thing. -}
showt :: (Show a, IsString b) => a -> b
showt :: forall a b. (Show a, IsString b) => a -> b
showt = String -> b
forall a. IsString a => String -> a
fromString (String -> b) -> (a -> String) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


{- |
  Show the JSON representation as any kind of string-like thing.
  Primarily useful for dumping JSON values into log messages without having to
  jump through too many hoops.
-}
showj :: (ToJSON a, IsString b) => a -> b
showj :: forall a b. (ToJSON a, IsString b) => a -> b
showj = String -> b
forall a. IsString a => String -> a
fromString (String -> b) -> (a -> String) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode


{- |
  Wrapper whose 'Show' instance outputs JSON.

  Especially useful with `-XDerivingVia`
  e.g.

  > newtype Foo = Foo SomeType
  >   deriving Show via (ShowJ SomeType)

  This will cause @show (foo :: Foo) to output the JSON representation
  of SomeType.
-}
newtype ShowJ a = ShowJ a
  deriving stock (ShowJ a -> ShowJ a -> Bool
(ShowJ a -> ShowJ a -> Bool)
-> (ShowJ a -> ShowJ a -> Bool) -> Eq (ShowJ a)
forall a. Eq a => ShowJ a -> ShowJ a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowJ a -> ShowJ a -> Bool
$c/= :: forall a. Eq a => ShowJ a -> ShowJ a -> Bool
== :: ShowJ a -> ShowJ a -> Bool
$c== :: forall a. Eq a => ShowJ a -> ShowJ a -> Bool
Eq, Eq (ShowJ a)
Eq (ShowJ a)
-> (ShowJ a -> ShowJ a -> Ordering)
-> (ShowJ a -> ShowJ a -> Bool)
-> (ShowJ a -> ShowJ a -> Bool)
-> (ShowJ a -> ShowJ a -> Bool)
-> (ShowJ a -> ShowJ a -> Bool)
-> (ShowJ a -> ShowJ a -> ShowJ a)
-> (ShowJ a -> ShowJ a -> ShowJ a)
-> Ord (ShowJ a)
ShowJ a -> ShowJ a -> Bool
ShowJ a -> ShowJ a -> Ordering
ShowJ a -> ShowJ a -> ShowJ a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ShowJ a)
forall a. Ord a => ShowJ a -> ShowJ a -> Bool
forall a. Ord a => ShowJ a -> ShowJ a -> Ordering
forall a. Ord a => ShowJ a -> ShowJ a -> ShowJ a
min :: ShowJ a -> ShowJ a -> ShowJ a
$cmin :: forall a. Ord a => ShowJ a -> ShowJ a -> ShowJ a
max :: ShowJ a -> ShowJ a -> ShowJ a
$cmax :: forall a. Ord a => ShowJ a -> ShowJ a -> ShowJ a
>= :: ShowJ a -> ShowJ a -> Bool
$c>= :: forall a. Ord a => ShowJ a -> ShowJ a -> Bool
> :: ShowJ a -> ShowJ a -> Bool
$c> :: forall a. Ord a => ShowJ a -> ShowJ a -> Bool
<= :: ShowJ a -> ShowJ a -> Bool
$c<= :: forall a. Ord a => ShowJ a -> ShowJ a -> Bool
< :: ShowJ a -> ShowJ a -> Bool
$c< :: forall a. Ord a => ShowJ a -> ShowJ a -> Bool
compare :: ShowJ a -> ShowJ a -> Ordering
$ccompare :: forall a. Ord a => ShowJ a -> ShowJ a -> Ordering
Ord)
  deriving newtype ([ShowJ a] -> Encoding
[ShowJ a] -> Value
ShowJ a -> Encoding
ShowJ a -> Value
(ShowJ a -> Value)
-> (ShowJ a -> Encoding)
-> ([ShowJ a] -> Value)
-> ([ShowJ a] -> Encoding)
-> ToJSON (ShowJ a)
forall a. ToJSON a => [ShowJ a] -> Encoding
forall a. ToJSON a => [ShowJ a] -> Value
forall a. ToJSON a => ShowJ a -> Encoding
forall a. ToJSON a => ShowJ a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ShowJ a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [ShowJ a] -> Encoding
toJSONList :: [ShowJ a] -> Value
$ctoJSONList :: forall a. ToJSON a => [ShowJ a] -> Value
toEncoding :: ShowJ a -> Encoding
$ctoEncoding :: forall a. ToJSON a => ShowJ a -> Encoding
toJSON :: ShowJ a -> Value
$ctoJSON :: forall a. ToJSON a => ShowJ a -> Value
ToJSON)
instance (ToJSON a) => Show (ShowJ a) where
  show :: ShowJ a -> String
show = ShowJ a -> String
forall a b. (ToJSON a, IsString b) => a -> b
showj