{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies               #-}
-- |
-- Module: Data.Greskell.AsLabel
-- Description: Label string used in .as step
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- @since 0.2.2.0
module Data.Greskell.AsLabel
    ( -- * AsLabel
      AsLabel (..)
    , SelectedMap
    , unsafeCastAsLabel
      -- * Re-exports
    , lookup
    , lookupM
    , lookupAs
    , lookupAsM
    , PMapLookupException (..)
      -- * LabeledP
    , LabeledP
    ) where

import           Prelude                hiding (lookup)

import           Control.Exception      (Exception)
import           Control.Monad.Catch    (MonadThrow (..))
import           Data.Foldable          (Foldable)
import           Data.Greskell.GraphSON (FromGraphSON (..), GValue, GraphSONTyped (..), parseEither)
import           Data.Greskell.Greskell (ToGreskell (..))
import qualified Data.Greskell.Greskell as Greskell
import           Data.Hashable          (Hashable)
import           Data.HashMap.Strict    (HashMap)
import qualified Data.HashMap.Strict    as HM
import           Data.String            (IsString (..))
import           Data.Text              (Text)
import           Data.Traversable       (Traversable)

import           Data.Greskell.Gremlin  (P, PLike (..))
import           Data.Greskell.PMap     (PMap, PMapKey (..), PMapLookupException (..), Single,
                                         lookup, lookupAs, lookupAsM, lookupM)

-- | 'AsLabel' @a@ represents a label string used in @.as@ step
-- pointing to the data of type @a@.
newtype AsLabel a
  = AsLabel { forall a. AsLabel a -> Text
unAsLabel :: Text }
  deriving (AsLabel a -> AsLabel a -> Bool
forall a. AsLabel a -> AsLabel a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsLabel a -> AsLabel a -> Bool
$c/= :: forall a. AsLabel a -> AsLabel a -> Bool
== :: AsLabel a -> AsLabel a -> Bool
$c== :: forall a. AsLabel a -> AsLabel a -> Bool
Eq, Int -> AsLabel a -> Int
AsLabel a -> Int
forall a. Eq (AsLabel a)
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Int -> AsLabel a -> Int
forall a. AsLabel a -> Int
hash :: AsLabel a -> Int
$chash :: forall a. AsLabel a -> Int
hashWithSalt :: Int -> AsLabel a -> Int
$chashWithSalt :: forall a. Int -> AsLabel a -> Int
Hashable, AsLabel a -> AsLabel a -> Bool
AsLabel a -> AsLabel a -> Ordering
AsLabel a -> AsLabel a -> AsLabel a
forall a. Eq (AsLabel a)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. AsLabel a -> AsLabel a -> Bool
forall a. AsLabel a -> AsLabel a -> Ordering
forall a. AsLabel a -> AsLabel a -> AsLabel a
min :: AsLabel a -> AsLabel a -> AsLabel a
$cmin :: forall a. AsLabel a -> AsLabel a -> AsLabel a
max :: AsLabel a -> AsLabel a -> AsLabel a
$cmax :: forall a. AsLabel a -> AsLabel a -> AsLabel a
>= :: AsLabel a -> AsLabel a -> Bool
$c>= :: forall a. AsLabel a -> AsLabel a -> Bool
> :: AsLabel a -> AsLabel a -> Bool
$c> :: forall a. AsLabel a -> AsLabel a -> Bool
<= :: AsLabel a -> AsLabel a -> Bool
$c<= :: forall a. AsLabel a -> AsLabel a -> Bool
< :: AsLabel a -> AsLabel a -> Bool
$c< :: forall a. AsLabel a -> AsLabel a -> Bool
compare :: AsLabel a -> AsLabel a -> Ordering
$ccompare :: forall a. AsLabel a -> AsLabel a -> Ordering
Ord, Int -> AsLabel a -> ShowS
forall a. Int -> AsLabel a -> ShowS
forall a. [AsLabel a] -> ShowS
forall a. AsLabel a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsLabel a] -> ShowS
$cshowList :: forall a. [AsLabel a] -> ShowS
show :: AsLabel a -> String
$cshow :: forall a. AsLabel a -> String
showsPrec :: Int -> AsLabel a -> ShowS
$cshowsPrec :: forall a. Int -> AsLabel a -> ShowS
Show)

-- | @since 1.0.0.0
instance IsString (AsLabel a) where
  fromString :: String -> AsLabel a
fromString = forall a. Text -> AsLabel a
AsLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- | Returns the 'Text' as a Gremlin string.
instance ToGreskell (AsLabel a) where
  type GreskellReturn (AsLabel a) = Text
  toGreskell :: AsLabel a -> Greskell (GreskellReturn (AsLabel a))
toGreskell (AsLabel Text
t) = Text -> Greskell Text
Greskell.string Text
t

-- | Unsafely convert the phantom type.
instance Functor AsLabel where
  fmap :: forall a b. (a -> b) -> AsLabel a -> AsLabel b
fmap a -> b
_ (AsLabel Text
t) = forall a. Text -> AsLabel a
AsLabel Text
t

-- | @since 1.0.0.0
instance PMapKey (AsLabel a) where
  type PMapValue (AsLabel a) = a
  keyText :: AsLabel a -> Text
keyText = forall a. AsLabel a -> Text
unAsLabel

-- | A map keyed with 'AsLabel'. Obtained from @.select@ step, for
-- example.
type SelectedMap = PMap Single

-- | Unsafely cast the phantom type of the 'AsLabel'.
--
-- @since 1.1.0.0
unsafeCastAsLabel :: AsLabel a -> AsLabel b
unsafeCastAsLabel :: forall a b. AsLabel a -> AsLabel b
unsafeCastAsLabel = forall a. Text -> AsLabel a
AsLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsLabel a -> Text
unAsLabel


-- | 'LabeledP' is just like 'P', a Haskell representation of
-- TinkerPop's @P@ class. Unlike 'P', however, 'LabeledP' keeps a
-- label ('AsLabel') inside. It is used in @.where@ step.
--
-- @since 1.2.0.0
data LabeledP a

-- Design note: neo4j-gremlin has `LabelP` class, which has nothing to
-- do with the 'LabeledP' type above.


-- | You can construct @Greskell (LabeledP a)@ from @AsLabel a@.
instance PLike (LabeledP a) where
  type PParameter (LabeledP a) = AsLabel a