module TD.Lib.Internal
  ( Extra (..),
    ShortShow (..),
    p,
    cc,
    readInt64,
    writeInt64,
    readBytes,
    writeBytes,
  )
where

import Data.Aeson qualified as A
import Data.Aeson.Types qualified as AT
import Data.ByteString qualified as BS
import Data.ByteString.Base64 qualified as B64
import Data.Hashable (Hashable)
import Data.List (intercalate)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import GHC.Generics (Generic)

newtype Extra = Extra String
  deriving (Extra -> Extra -> Bool
(Extra -> Extra -> Bool) -> (Extra -> Extra -> Bool) -> Eq Extra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Extra -> Extra -> Bool
== :: Extra -> Extra -> Bool
$c/= :: Extra -> Extra -> Bool
/= :: Extra -> Extra -> Bool
Eq, (forall x. Extra -> Rep Extra x)
-> (forall x. Rep Extra x -> Extra) -> Generic Extra
forall x. Rep Extra x -> Extra
forall x. Extra -> Rep Extra x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Extra -> Rep Extra x
from :: forall x. Extra -> Rep Extra x
$cto :: forall x. Rep Extra x -> Extra
to :: forall x. Rep Extra x -> Extra
Generic)

instance Hashable Extra

instance AT.FromJSON Extra where
  parseJSON :: Value -> Parser Extra
parseJSON (AT.Object Object
obj) = String -> Extra
Extra (String -> Extra) -> Parser String -> Parser Extra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"@extra"
  parseJSON Value
_ = Parser Extra
forall a. Monoid a => a
mempty

-- | Show class alternative that hides unset and bytes values,
-- multiline text values are shown as single line
class ShortShow a where
  shortShow :: a -> String

instance ShortShow Int where
  shortShow :: Int -> String
shortShow = Int -> String
forall a. Show a => a -> String
show

instance ShortShow Double where
  shortShow :: Double -> String
shortShow = Double -> String
forall a. Show a => a -> String
show

instance ShortShow Bool where
  shortShow :: Bool -> String
shortShow = Bool -> String
forall a. Show a => a -> String
show

instance ShortShow T.Text where
  shortShow :: Text -> String
shortShow Text
x =
    Text -> String
T.unpack
      (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
'"'
      (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
" "
      ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
      (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
T.snoc Text
x Char
'"'

instance ShortShow BS.ByteString where
  shortShow :: ByteString -> String
shortShow ByteString
_ = String
"<bytes>"

instance (ShortShow a) => ShortShow [a] where
  shortShow :: [a] -> String
shortShow [a]
xs = String
"[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. ShortShow a => a -> String
shortShow [a]
xs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]"

p :: (ShortShow a) => String -> Maybe a -> String
p :: forall a. ShortShow a => String -> Maybe a -> String
p String
k (Just a
v) = String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. ShortShow a => a -> String
shortShow a
v
p String
_ Maybe a
Nothing = String
""

cc :: [String] -> String
cc :: [String] -> String
cc [] = String
forall a. Monoid a => a
mempty
cc [String]
a = String
" {" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"

readInt64 :: String -> Int
readInt64 :: String -> Int
readInt64 = String -> Int
forall a. Read a => String -> a
read

writeInt64 :: Int -> AT.Value
writeInt64 :: Int -> Value
writeInt64 = Text -> Value
AT.String (Text -> Value) -> (Int -> Text) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

-- decode base64 string as bytestring
readBytes :: String -> BS.ByteString
readBytes :: String -> ByteString
readBytes = ByteString -> ByteString
B64.decodeLenient (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- encode bytestring as base64 string
writeBytes :: BS.ByteString -> AT.Value
writeBytes :: ByteString -> Value
writeBytes ByteString
x = Text -> Value
AT.String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
x