{-# 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
----------------------------------------------------------------------------
-- | Encodes DAP protocol message appropriately
-- >
encodeBaseProtocolMessage :: ToJSON a => a -> ByteString
encodeBaseProtocolMessage :: forall a. ToJSON a => a -> ByteString
encodeBaseProtocolMessage a
msg =
  forall a. Monoid a => [a] -> a
mconcat
  [ ByteString
"Content-Length: " forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS.pack (forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bytes)) forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n\r\n"
  , ByteString
bytes
  ] where
      bytes :: ByteString
bytes = ByteString -> ByteString
BL8.toStrict (forall a. ToJSON a => a -> ByteString
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 forall a. a -> [a] -> [a]
: String
xs
  | Bool
otherwise = Char
x 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 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
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length (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 = forall a. Show a => a -> String
show (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
  = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions
  { fieldLabelModifier :: String -> String
fieldLabelModifier = forall a (proxy :: * -> *).
Typeable a =>
proxy a -> String -> String
modifier (forall {k} (t :: k). Proxy t
Proxy @a)
  , constructorTagModifier :: String -> String
constructorTagModifier = forall a (proxy :: * -> *).
Typeable a =>
proxy a -> String -> String
modifier (forall {k} (t :: k). Proxy t
Proxy @a)
  , sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue
  , omitNothingFields :: Bool
omitNothingFields = Bool
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
  = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions
  { fieldLabelModifier :: String -> String
fieldLabelModifier = forall a (proxy :: * -> *).
Typeable a =>
proxy a -> String -> String
modifier (forall {k} (t :: k). Proxy t
Proxy @a)
  , constructorTagModifier :: String -> String
constructorTagModifier = forall a (proxy :: * -> *).
Typeable a =>
proxy a -> String -> String
modifier (forall {k} (t :: k). Proxy t
Proxy @a)
  , sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue
  , omitNothingFields :: Bool
omitNothingFields = Bool
True
  }
----------------------------------------------------------------------------
-- | Log formatting util
withBraces :: BL8.ByteString -> BL8.ByteString
withBraces :: ByteString -> ByteString
withBraces ByteString
x  = ByteString
"[" forall a. Semigroup a => a -> a -> a
<> ByteString
x forall a. Semigroup a => a -> a -> a
<> ByteString
"]"
----------------------------------------------------------------------------