module Hunt.Common.DocDesc
where
import Prelude hiding (lookup)
import Control.Arrow (second)
import Control.DeepSeq
import Control.Monad (mzero)
import Data.Aeson (FromJSON (..), Object, Result (..),
ToJSON (..), Value (..), decode, encode,
fromJSON)
import Data.Binary (Binary (..))
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text.Binary ()
import Data.Typeable
newtype DocDesc
= DocDesc { unDesc :: Object }
deriving (Eq, Show, NFData, Typeable)
mkDocDesc :: Object -> DocDesc
mkDocDesc o
= DocDesc $!! o
instance Binary DocDesc where
put = put . encode . unDesc
get = do bs <- get
case decode bs of
Nothing -> fail "DocDesc.get: error in decoding from JSON"
Just x -> return $! (mkDocDesc x)
instance ToJSON DocDesc where
toJSON = Object . unDesc
instance FromJSON DocDesc where
parseJSON (Object o) = return $! (mkDocDesc o)
parseJSON _ = mzero
empty :: DocDesc
empty = mkDocDesc HM.empty
null :: DocDesc -> Bool
null (DocDesc m) = HM.null m
insert :: ToJSON v => Text -> v -> DocDesc -> DocDesc
insert k v (DocDesc m)
= mkDocDesc $ HM.insert k (toJSON v) m
delete :: Text -> DocDesc -> DocDesc
delete k (DocDesc m)
= mkDocDesc $ HM.delete k m
union :: DocDesc -> DocDesc -> DocDesc
union (DocDesc m1) (DocDesc m2)
= mkDocDesc $ HM.union m1 m2
restrict :: [Text] -> DocDesc -> DocDesc
restrict ks (DocDesc m)
= mkDocDesc $ HM.filterWithKey sel m
where
sel k _v = k `elem` ks
deleteNull :: DocDesc -> DocDesc
deleteNull (DocDesc m)
= mkDocDesc $ HM.filter notNull m
where
notNull Null = False
notNull _ = True
lookupValue :: Text -> DocDesc -> Value
lookupValue k (DocDesc m)
= fromMaybe Null $ HM.lookup k m
lookup :: FromJSON v => Text -> DocDesc -> Maybe v
lookup k d
= toMaybe . fromJSON . lookupValue k $ d
where
toMaybe (Success v) = Just v
toMaybe _ = Nothing
lookupText :: Text -> DocDesc -> Text
lookupText k d
= fromMaybe "" . lookup k $ d
fromList :: ToJSON v => [(Text, v)] -> DocDesc
fromList l = mkDocDesc $ HM.fromList (map (second toJSON) l)
toList :: DocDesc -> [(Text, Value)]
toList (DocDesc m) = HM.toList m