{-# LANGUAGE OverloadedStrings, TypeFamilies, GeneralizedNewtypeDeriving, DeriveTraversable #-}
module Data.Greskell.AsLabel
( AsLabel(..),
SelectedMap,
lookup,
lookupM,
lookupAs,
lookupAsM,
AsLookupException(..)
) where
import Prelude hiding (lookup)
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow(..))
import Data.Foldable (Foldable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Greskell.GraphSON (GValue, GraphSONTyped(..), FromGraphSON(..), parseEither)
import Data.Greskell.Greskell (ToGreskell(..))
import qualified Data.Greskell.Greskell as Greskell
import Data.Text (Text)
import Data.Traversable (Traversable)
newtype AsLabel a = AsLabel { unAsLabel :: Text }
deriving (Show,Eq,Ord)
instance ToGreskell (AsLabel a) where
type GreskellReturn (AsLabel a) = Text
toGreskell (AsLabel t) = Greskell.string t
instance Functor AsLabel where
fmap _ (AsLabel t) = AsLabel t
newtype SelectedMap a = SelectedMap (HashMap Text a)
deriving (Show,Eq,Functor,Foldable,Traversable)
instance GraphSONTyped (SelectedMap a) where
gsonTypeFor _ = "g:Map"
instance FromGraphSON a => FromGraphSON (SelectedMap a) where
parseGraphSON gv = fmap SelectedMap $ parseGraphSON gv
data AsLookupException = NoSuchAsLabel
| ParseError String
deriving (Show,Eq,Ord)
instance Exception AsLookupException
lookup :: AsLabel a -> SelectedMap b -> Maybe b
lookup (AsLabel l) (SelectedMap m) = HM.lookup l m
lookupM :: MonadThrow m => AsLabel a -> SelectedMap b -> m b
lookupM l m = maybe (throwM NoSuchAsLabel) return $ lookup l m
lookupAs :: FromGraphSON a => AsLabel a -> SelectedMap GValue -> Either AsLookupException a
lookupAs l m =
case lookup l m of
Nothing -> Left NoSuchAsLabel
Just gv -> either (Left . ParseError) Right $ parseEither gv
lookupAsM :: (MonadThrow m, FromGraphSON a) => AsLabel a -> SelectedMap GValue -> m a
lookupAsM l m = either throwM return $ lookupAs l m