module Bloodhound.Import
  ( 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.Types          as X (Pair, Parser, emptyObject,
                                                 parseEither, parseMaybe,
                                                 typeMismatch)
import           Data.Bifunctor            as X (first)
import           Data.Char                 as X (isNumber)
import           Data.Hashable             as X (Hashable)
import qualified Data.HashMap.Strict       as HM
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.Time.Calendar        as X (Day (..), showGregorian)
import           Data.Time.Clock           as X (NominalDiffTime, UTCTime)
import           Data.Time.Clock.POSIX     as X

import qualified Data.ByteString.Lazy      as BL
import qualified Data.Text                 as T
import qualified Data.Traversable          as DT
import qualified Data.Vector               as V
import qualified Network.HTTP.Types.Method as NHTM

type LByteString = BL.ByteString

type Method = NHTM.Method

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

parseReadText :: Read a => Text -> Parser a
parseReadText :: Text -> Parser a
parseReadText = Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Parser a) -> (Text -> Maybe a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMay (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

showText :: Show a => a -> Text
showText :: a -> Text
showText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

omitNulls :: [(Text, Value)] -> Value
omitNulls :: [(Text, Value)] -> Value
omitNulls = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value)
-> ([(Text, Value)] -> [(Text, Value)]) -> [(Text, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> Bool) -> [(Text, Value)] -> [(Text, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text, Value) -> Bool
forall a. (a, Value) -> Bool
notNull where
  notNull :: (a, Value) -> Bool
notNull (a
_, Value
Null)    = Bool
False
  notNull (a
_, Array Array
a) = (Bool -> Bool
not (Bool -> Bool) -> (Array -> Bool) -> Array -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Bool
forall a. Vector a -> Bool
V.null) Array
a
  notNull (a, Value)
_            = Bool
True

parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
parseNEJSON :: [Value] -> Parser (NonEmpty a)
parseNEJSON []     = String -> Parser (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected non-empty list"
parseNEJSON (Value
x:[Value]
xs) = (Value -> Parser a) -> NonEmpty Value -> Parser (NonEmpty a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
DT.mapM Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Value
x Value -> [Value] -> NonEmpty Value
forall a. a -> [a] -> NonEmpty a
:| [Value]
xs)

deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
deleteSeveral :: [k] -> HashMap k v -> HashMap k v
deleteSeveral [k]
ks HashMap k v
hm = (k -> HashMap k v -> HashMap k v)
-> HashMap k v -> [k] -> HashMap k v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr k -> HashMap k v -> HashMap k v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete HashMap k v
hm [k]
ks

oPath :: ToJSON a => NonEmpty Text -> a -> Value
oPath :: NonEmpty Text -> a -> Value
oPath (Text
k :| []) a
v   = [(Text, Value)] -> Value
object [Text
k Text -> a -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
v]
oPath (Text
k:| (Text
h:[Text]
t)) a
v = [(Text, Value)] -> Value
object [Text
k Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NonEmpty Text -> a -> Value
forall a. ToJSON a => NonEmpty Text -> a -> Value
oPath (Text
h Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
t) a
v]

tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show