Imports.hs

module Database.Bloodhound.Internal.Utils.Imports
  ( module X,
    LByteString,
    Method,
    omitNulls,
    parseNEJSON,
    parseReadText,
    readMay,
    showText,
    deleteSeveral,
    oPath,
    tshow,
  )
where

import Control.Applicative as X (Alternative (..), optional)
import Control.Exception as X (Exception)
import Control.Monad as X (MonadPlus (..), forM, (<=<))
import Control.Monad.Catch as X
  ( MonadCatch,
    MonadMask,
    MonadThrow,
  )
import Control.Monad.Except as X (MonadError)
import Control.Monad.Fix as X (MonadFix)
import Control.Monad.IO.Class as X (MonadIO (..))
import Control.Monad.Reader as X
  ( MonadReader (..),
    MonadTrans (..),
    ReaderT (..),
  )
import Control.Monad.State as X (MonadState)
import Control.Monad.Writer as X (MonadWriter)
import Data.Aeson as X
import Data.Aeson.Key as X
import Data.Aeson.KeyMap qualified as X
import Data.Aeson.Types as X
  ( Pair,
    Parser,
    emptyObject,
    parseEither,
    parseMaybe,
    typeMismatch,
  )
import Data.Bifunctor as X (first)
import Data.ByteString.Lazy qualified as BL
import Data.Char as X (isNumber)
import Data.Hashable as X (Hashable)
import Data.List as X (foldl', intercalate, nub)
import Data.List.NonEmpty as X (NonEmpty (..), toList)
import Data.Maybe as X
  ( catMaybes,
    fromMaybe,
    isNothing,
    maybeToList,
  )
import Data.Scientific as X (Scientific)
import Data.Semigroup as X (Semigroup (..))
import Data.Text as X (Text)
import Data.Text qualified as T
import Data.Time.Calendar as X (Day (..), showGregorian)
import Data.Time.Clock as X (NominalDiffTime, UTCTime)
import Data.Time.Clock.POSIX as X
import Data.Traversable qualified as DT
import Data.Vector qualified as V
import Network.HTTP.Types.Method qualified as NHTM
import Optics.Core as X
  ( Lens',
    Prism',
    lens,
    prism,
  )

type LByteString = BL.ByteString

type Method = NHTM.Method

readMay :: (Read a) => String -> Maybe a
readMay s = case reads s of
  (a, "") : _ -> Just a
  _ -> Nothing

parseReadText :: (Read a) => Text -> Parser a
parseReadText = maybe mzero return . readMay . T.unpack

showText :: (Show a) => a -> Text
showText = T.pack . show

-- |
-- import qualified Data.Aeson.KeyMap as X
-- import qualified Data.Vector as V
-- import Data.Text
--
-- >>> omitNulls [ "test1" .= (toJSON ([] :: [Int])), "test2" .= (toJSON ("some value" :: Text)) ]
-- Object (X.fromList [("test2", String "some value")])
--
-- >>> omitNulls [ "test1" .= (toJSON ([1] :: [Int])), "test2" .= (toJSON ("some value" :: Text)) ]
-- Object ( X.fromList [ ("test1", Array (V.fromList [Number 1.0])), ("test2", String "some value") ] )
--
-- >>> omitNulls [ "test1" .= (toJSON Null), "test2" .= (toJSON ("some value" :: Text)) ]
-- Object (X.fromList [("test2", String "some value")])
--
-- >>> omitNulls [ "test1" .= (toJSON (1 :: Int)), "test2" .= (toJSON ("some value" :: Text)) ]
-- Object ( X.fromList [ ("test1", Number 1.0), ("test2", String "some value") ] )
omitNulls :: [(Key, Value)] -> Value
omitNulls = object . filter notNull
  where
    notNull (_, Null) = False
    notNull (_, Array a) = (not . V.null) a
    notNull _ = True

parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
parseNEJSON [] = fail "Expected non-empty list"
parseNEJSON (x : xs) = DT.mapM parseJSON (x :| xs)

deleteSeveral :: [Key] -> X.KeyMap v -> X.KeyMap v
deleteSeveral ks km = foldr X.delete km ks

oPath :: (ToJSON a) => NonEmpty Key -> a -> Value
oPath (k :| []) v = object [k .= v]
oPath (k :| (h : t)) v = object [k .= oPath (h :| t) v]

tshow :: (Show a) => a -> Text
tshow = T.pack . show