{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
----------------------------------------------------------------------------
-- |
-- Module      :  DAP.Utils
-- Copyright   :  (C) 2023 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module DAP.Utils where
----------------------------------------------------------------------------
import           GHC.Generics               (Generic, Rep)
import           Data.Aeson                 ( ToJSON, Value, fieldLabelModifier
                                            , genericToJSON, genericParseJSON, fieldLabelModifier
                                            , defaultOptions, GToJSON, GFromJSON, Zero
                                            , constructorTagModifier, sumEncoding
                                            , SumEncoding(UntaggedValue), omitNothingFields
                                            )
import           Data.Aeson.Types           ( Parser )
import           Data.Aeson.Encode.Pretty   ( encodePretty )
import           Data.ByteString            ( ByteString )
import           Data.Char                  ( isLower, toLower, toUpper )
import           Data.Proxy                 (Proxy(Proxy))
import           Data.Typeable              ( Typeable, typeRep )
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.ByteString.Char8      as BS
import qualified Data.Text as T
----------------------------------------------------------------------------
-- | Encodes DAP protocol message appropriately
-- >
encodeBaseProtocolMessage :: ToJSON a => a -> ByteString
encodeBaseProtocolMessage :: forall a. ToJSON a => a -> ByteString
encodeBaseProtocolMessage a
msg =
  [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
  [ ByteString
"Content-Length: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS.pack (Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bytes)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n\r\n"
  , ByteString
bytes
  ] where
      bytes :: ByteString
bytes = LazyByteString -> ByteString
BL8.toStrict (a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encodePretty a
msg)
----------------------------------------------------------------------------
-- | Capitalization helper function
-- >>> capitalize "fooBar"
-- >>> "FooBar"
capitalize :: String -> String
capitalize :: String -> String
capitalize [] = []
capitalize (Char
x:String
xs)
  | Char -> Bool
isLower Char
x = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
  | Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
----------------------------------------------------------------------------
-- | Lower cases a word
-- >>> toLowerCase "FooBar"
-- >>> "fooBar"
toLowerCase :: String -> String
toLowerCase :: String -> String
toLowerCase [] = []
toLowerCase (Char
x:String
xs) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
----------------------------------------------------------------------------
-- | Used as a fieldLabelModifier when generating aeson parsers
-- >>> modifier (Proxy @Int) "intThing"
-- >>> String "thing"
modifier
  :: Typeable a
  => proxy a
  -> String
  -> String
modifier :: forall a (proxy :: * -> *).
Typeable a =>
proxy a -> String -> String
modifier proxy a
proxy
  = String -> String
toLowerCase
  (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (proxy a -> String
forall a (proxy :: * -> *). Typeable a => proxy a -> String
getName proxy a
proxy))
----------------------------------------------------------------------------
-- | Used as a fieldLabelModifier when generating aeson parsers
-- >>> getName (Proxy @Int)
-- >>> "Int"
getName
  :: Typeable a
  => proxy a
  -> String
getName :: forall a (proxy :: * -> *). Typeable a => proxy a -> String
getName proxy a
proxy = TypeRep -> String
forall a. Show a => a -> String
show (proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep proxy a
proxy)
----------------------------------------------------------------------------
-- | Used as a fieldLabelModifier when generating aeson parsers
-- >>> getName (Proxy @Int)
-- >>> "Int"
genericToJSONWithModifier
  :: forall a . (Generic a, GToJSON Zero (Rep a), Typeable a)
  => a -> Value
genericToJSONWithModifier :: forall a.
(Generic a, GToJSON Zero (Rep a), Typeable a) =>
a -> Value
genericToJSONWithModifier
  = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions
  { fieldLabelModifier = modifier (Proxy @a)
  , constructorTagModifier = modifier (Proxy @a)
  , sumEncoding = UntaggedValue
  , omitNothingFields = True
  }
----------------------------------------------------------------------------
-- | Used as a fieldLabelModifier when generating aeson parsers
-- >>> getName (Proxy @Int)
-- >>> "Int"
genericParseJSONWithModifier
  :: forall a . (Generic a, GFromJSON Zero (Rep a), Typeable a)
  => Value
  -> Parser a
genericParseJSONWithModifier :: forall a.
(Generic a, GFromJSON Zero (Rep a), Typeable a) =>
Value -> Parser a
genericParseJSONWithModifier
  = Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions
  { fieldLabelModifier = modifier (Proxy @a)
  , constructorTagModifier = modifier (Proxy @a)
  , sumEncoding = UntaggedValue
  , omitNothingFields = True
  }
----------------------------------------------------------------------------
-- | Log formatting util
withBraces :: T.Text -> T.Text
withBraces :: Text -> Text
withBraces Text
x  = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
----------------------------------------------------------------------------