Type.hs

-- | Internal module. Not part of the public API.
--
-- Bolt value types: the Haskell representation of Neo4j values returned by queries.
module Database.Bolty.Value.Type
  ( Bolt(..)
    -- * Bolt value extractors
  , asNull, asBool, asInt, asFloat, asBytes, asText
  , asList, asDict, asNode, asRelationship, asPath
    -- * Graph types
  , Node(..)
  , Relationship(..)
  , UnboundRelationship(..)
  , Path(..)
    -- * Temporal types
  , Date(..)
  , Time(..)
  , LocalTime(..)
  , DateTime(..)
  , DateTimeZoneId(..)
  , LocalDateTime(..)
  , Duration(..)
    -- * Spatial types
  , Point2D(..)
  , Point3D(..)
  ) where

import           Data.Int              (Int64)
import           Data.Kind             (Type)
import           GHC.Generics          (Generic)
import qualified Data.ByteString       as BS
import qualified Data.HashMap.Lazy     as H
import qualified Data.Text             as T
import qualified Data.Vector           as V

import           Data.PackStream.Ps
import           Data.PackStream.Result  (Result(..))
import           Data.PackStream.Integer (PSInteger)
import           Database.Bolty.Value.Helpers (sigNode, sigRel, sigURel, sigPath
                                              , sigDate, sigTime, sigLocalTime, sigDateTime
                                              , sigDateTimeZoneId, sigLocalDateTime, sigDuration
                                              , sigPoint2D, sigPoint3D)
import           Numeric                (showHex)


-- | A typed Neo4j value. Every field in a query result record is a 'Bolt'.
type Bolt :: Type
data Bolt
  = BoltNull
  | BoltBoolean !Bool
  | BoltInteger !PSInteger
  | BoltFloat !Double
  | BoltBytes !BS.ByteString
  | BoltString !T.Text
  | BoltList !(V.Vector Bolt)
  | BoltDictionary !(H.HashMap T.Text Bolt)
  | BoltNode Node
  | BoltRelationship Relationship
  | BoltUnboundRelationship UnboundRelationship
  | BoltPath Path
  | BoltDate Date
  | BoltTime Time
  | BoltLocalTime LocalTime
  | BoltDateTime DateTime
  | BoltDateTimeZoneId DateTimeZoneId
  | BoltLocalDateTime LocalDateTime
  | BoltDuration Duration
  | BoltPoint2D Point2D
  | BoltPoint3D Point3D
  deriving stock (Show, Eq, Generic)

instance PackStream Bolt where
  toPs BoltNull                    = PsNull
  toPs (BoltBoolean b)             = PsBoolean b
  toPs (BoltInteger n)             = PsInteger n
  toPs (BoltFloat d)               = PsFloat d
  toPs (BoltBytes b)               = PsBytes b
  toPs (BoltString t)              = PsString t
  toPs (BoltList v)                = PsList (V.map toPs v)
  toPs (BoltDictionary m)          = PsDictionary (H.map toPs m)
  toPs (BoltNode n)                = toPs n
  toPs (BoltRelationship r)        = toPs r
  toPs (BoltUnboundRelationship r) = toPs r
  toPs (BoltPath p)                = toPs p
  toPs (BoltDate d)                = toPs d
  toPs (BoltTime t)                = toPs t
  toPs (BoltLocalTime t)           = toPs t
  toPs (BoltDateTime dt)           = toPs dt
  toPs (BoltDateTimeZoneId dt)     = toPs dt
  toPs (BoltLocalDateTime dt)      = toPs dt
  toPs (BoltDuration d)            = toPs d
  toPs (BoltPoint2D p)             = toPs p
  toPs (BoltPoint3D p)             = toPs p

  fromPs PsNull         = Success BoltNull
  fromPs (PsBoolean b)  = Success (BoltBoolean b)
  fromPs (PsInteger n)  = Success (BoltInteger n)
  fromPs (PsFloat d)    = Success (BoltFloat d)
  fromPs (PsBytes b)    = Success (BoltBytes b)
  fromPs (PsString t)   = Success (BoltString t)
  fromPs (PsList v)     = BoltList <$> traverse fromPs v
  fromPs (PsDictionary m) = BoltDictionary <$> traverse fromPs m
  fromPs ps@(PsStructure t _) = case t of
    _ | t == sigNode    -> BoltNode <$> fromPs ps
      | t == sigRel     -> BoltRelationship <$> fromPs ps
      | t == sigURel    -> BoltUnboundRelationship <$> fromPs ps
      | t == sigPath    -> BoltPath <$> fromPs ps
      | t == sigDate    -> BoltDate <$> fromPs ps
      | t == sigTime    -> BoltTime <$> fromPs ps
      | t == sigLocalTime    -> BoltLocalTime <$> fromPs ps
      | t == sigDateTime     -> BoltDateTime <$> fromPs ps
      | t == sigDateTimeZoneId -> BoltDateTimeZoneId <$> fromPs ps
      | t == sigLocalDateTime  -> BoltLocalDateTime <$> fromPs ps
      | t == sigDuration -> BoltDuration <$> fromPs ps
      | t == sigPoint2D  -> BoltPoint2D <$> fromPs ps
      | t == sigPoint3D  -> BoltPoint3D <$> fromPs ps
      | otherwise -> Error $ "unknown structure tag: 0x" <> T.pack (showHex t "")


-- | A graph node.
type Node :: Type
data Node = Node
  { id         :: !Int64
  -- ^ Legacy numeric ID (use 'element_id' for BOLT 5+).
  , labels     :: !(V.Vector T.Text)
  -- ^ Node labels.
  , properties :: !(H.HashMap T.Text Ps)
  -- ^ Node properties.
  , element_id :: !T.Text
  -- ^ Element ID string (empty on BOLT 4.x).
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Node where
  toPs Node{id, labels, properties, element_id} =
    PsStructure sigNode $ V.fromList [toPs id, toPs labels, toPs properties, toPs element_id]
  -- BOLT 5+: 4 fields (id, labels, properties, element_id)
  fromPs (PsStructure t fs) | t == sigNode, V.length fs == 4 =
    Node <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2) <*> fromPs (fs V.! 3)
  -- BOLT 4.x: 3 fields (id, labels, properties) — no element_id
  fromPs (PsStructure t fs) | t == sigNode, V.length fs == 3 =
    Node <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2) <*> pure ""
  fromPs other = typeMismatch "Node" other

-- | A graph relationship (edge).
type Relationship :: Type
data Relationship = Relationship
  { id                     :: !Int64
  -- ^ Legacy numeric ID.
  , startNodeId            :: !Int64
  -- ^ Legacy numeric ID of the start node.
  , endNodeId              :: !Int64
  -- ^ Legacy numeric ID of the end node.
  , type_                  :: !T.Text
  -- ^ Relationship type name.
  , properties             :: !(H.HashMap T.Text Ps)
  -- ^ Relationship properties.
  , element_id             :: !T.Text
  -- ^ Element ID string (empty on BOLT 4.x).
  , start_node_element_id  :: !T.Text
  -- ^ Start node element ID (empty on BOLT 4.x).
  , end_node_element_id    :: !T.Text
  -- ^ End node element ID (empty on BOLT 4.x).
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Relationship where
  toPs Relationship{id, startNodeId, endNodeId, type_, properties, element_id, start_node_element_id, end_node_element_id} =
    PsStructure sigRel $ V.fromList
      [toPs id, toPs startNodeId, toPs endNodeId, toPs type_, toPs properties
      , toPs element_id, toPs start_node_element_id, toPs end_node_element_id]
  -- BOLT 5+: 8 fields (id, startNodeId, endNodeId, type_, properties, element_id, start_node_element_id, end_node_element_id)
  fromPs (PsStructure t fs) | t == sigRel, V.length fs == 8 =
    Relationship <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2)
                 <*> fromPs (fs V.! 3) <*> fromPs (fs V.! 4) <*> fromPs (fs V.! 5)
                 <*> fromPs (fs V.! 6) <*> fromPs (fs V.! 7)
  -- BOLT 4.x: 5 fields (id, startNodeId, endNodeId, type_, properties) — no element_id fields
  fromPs (PsStructure t fs) | t == sigRel, V.length fs == 5 =
    Relationship <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2)
                 <*> fromPs (fs V.! 3) <*> fromPs (fs V.! 4) <*> pure "" <*> pure "" <*> pure ""
  fromPs other = typeMismatch "Relationship" other


-- | A relationship without start\/end node information (used in paths).
type UnboundRelationship :: Type
data UnboundRelationship = UnboundRelationship
  { id         :: !Int64
  , type_      :: !T.Text
  -- ^ Relationship type name.
  , properties :: !(H.HashMap T.Text Ps)
  , element_id :: !T.Text
  -- ^ Element ID string (empty on BOLT 4.x).
  }
  deriving stock (Show, Eq, Generic)
instance PackStream UnboundRelationship where
  toPs UnboundRelationship{id, type_, properties, element_id} =
    PsStructure sigURel $ V.fromList [toPs id, toPs type_, toPs properties, toPs element_id]
  -- BOLT 5+: 4 fields (id, type_, properties, element_id)
  fromPs (PsStructure t fs) | t == sigURel, V.length fs == 4 =
    UnboundRelationship <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2) <*> fromPs (fs V.! 3)
  -- BOLT 4.x: 3 fields (id, type_, properties) — no element_id
  fromPs (PsStructure t fs) | t == sigURel, V.length fs == 3 =
    UnboundRelationship <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2) <*> pure ""
  fromPs other = typeMismatch "UnboundRelationship" other


-- | A graph path: an alternating sequence of nodes and relationships.
type Path :: Type
data Path = Path
  { nodes   :: !(V.Vector Node)
  -- ^ Unique nodes in the path.
  , rels    :: !(V.Vector UnboundRelationship)
  -- ^ Unique relationships in the path.
  , indices :: !(V.Vector Int64)
  -- ^ Indices into 'nodes' and 'rels' describing the traversal order.
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Path where
  toPs Path{nodes, rels, indices} =
    PsStructure sigPath $ V.fromList [toPs nodes, toPs rels, toPs indices]
  fromPs (PsStructure t fs) | t == sigPath, V.length fs == 3 =
    Path <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2)
  fromPs other = typeMismatch "Path" other


-- | A date (days since Unix epoch).
type Date :: Type
data Date = Date
  { days :: !Int64
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Date where
  toPs Date{days} =
    PsStructure sigDate $ V.singleton (toPs days)
  fromPs (PsStructure t fs) | t == sigDate, V.length fs == 1 =
    Date <$> fromPs (fs V.! 0)
  fromPs other = typeMismatch "Date" other


-- | A time with timezone offset.
type Time :: Type
data Time = Time
  { nanoseconds       :: !Int64
  -- ^ Nanoseconds since midnight.
  , tz_offset_seconds :: !Int64
  -- ^ Timezone offset in seconds from UTC.
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Time where
  toPs Time{nanoseconds, tz_offset_seconds} =
    PsStructure sigTime $ V.fromList [toPs nanoseconds, toPs tz_offset_seconds]
  fromPs (PsStructure t fs) | t == sigTime, V.length fs == 2 =
    Time <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1)
  fromPs other = typeMismatch "Time" other


-- | A local time (no timezone).
type LocalTime :: Type
data LocalTime = LocalTime
  { nanoseconds :: !Int64
  -- ^ Nanoseconds since midnight.
  }
  deriving stock (Show, Eq, Generic)
instance PackStream LocalTime where
  toPs LocalTime{nanoseconds} =
    PsStructure sigLocalTime $ V.singleton (toPs nanoseconds)
  fromPs (PsStructure t fs) | t == sigLocalTime, V.length fs == 1 =
    LocalTime <$> fromPs (fs V.! 0)
  fromPs other = typeMismatch "LocalTime" other


-- | A date-time with timezone offset.
type DateTime :: Type
data DateTime = DateTime
  { seconds           :: !Int64
  -- ^ Seconds since Unix epoch.
  , nanoseconds       :: !Int64
  -- ^ Nanosecond adjustment.
  , tz_offset_seconds :: !Int64
  -- ^ Timezone offset in seconds from UTC.
  }
  deriving stock (Show, Eq, Generic)
instance PackStream DateTime where
  toPs DateTime{seconds, nanoseconds, tz_offset_seconds} =
    PsStructure sigDateTime $ V.fromList [toPs seconds, toPs nanoseconds, toPs tz_offset_seconds]
  fromPs (PsStructure t fs) | t == sigDateTime, V.length fs == 3 =
    DateTime <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2)
  fromPs other = typeMismatch "DateTime" other


-- | A date-time with named timezone (e.g. @\"Europe\/Paris\"@).
type DateTimeZoneId :: Type
data DateTimeZoneId = DateTimeZoneId
  { seconds     :: !Int64
  -- ^ Seconds since Unix epoch.
  , nanoseconds :: !Int64
  -- ^ Nanosecond adjustment.
  , tz_id       :: !T.Text
  -- ^ IANA timezone identifier.
  }
  deriving stock (Show, Eq, Generic)
instance PackStream DateTimeZoneId where
  toPs DateTimeZoneId{seconds, nanoseconds, tz_id} =
    PsStructure sigDateTimeZoneId $ V.fromList [toPs seconds, toPs nanoseconds, toPs tz_id]
  fromPs (PsStructure t fs) | t == sigDateTimeZoneId, V.length fs == 3 =
    DateTimeZoneId <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2)
  fromPs other = typeMismatch "DateTimeZoneId" other


-- | A local date-time (no timezone).
type LocalDateTime :: Type
data LocalDateTime = LocalDateTime
  { seconds     :: !Int64
  -- ^ Seconds since Unix epoch.
  , nanoseconds :: !Int64
  -- ^ Nanosecond adjustment.
  }
  deriving stock (Show, Eq, Generic)
instance PackStream LocalDateTime where
  toPs LocalDateTime{seconds, nanoseconds} =
    PsStructure sigLocalDateTime $ V.fromList [toPs seconds, toPs nanoseconds]
  fromPs (PsStructure t fs) | t == sigLocalDateTime, V.length fs == 2 =
    LocalDateTime <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1)
  fromPs other = typeMismatch "LocalDateTime" other


-- | A temporal duration (months, days, seconds, nanoseconds).
type Duration :: Type
data Duration = Duration
  { months      :: !Int64
  , days        :: !Int64
  , seconds     :: !Int64
  , nanoseconds :: !Int64
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Duration where
  toPs Duration{months, days, seconds, nanoseconds} =
    PsStructure sigDuration $ V.fromList [toPs months, toPs days, toPs seconds, toPs nanoseconds]
  fromPs (PsStructure t fs) | t == sigDuration, V.length fs == 4 =
    Duration <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2) <*> fromPs (fs V.! 3)
  fromPs other = typeMismatch "Duration" other


-- | A 2D spatial point.
type Point2D :: Type
data Point2D = Point2D
  { srid :: !Int64
  -- ^ Spatial Reference Identifier (e.g. 4326 for WGS-84).
  , x    :: !Double
  , y    :: !Double
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Point2D where
  toPs Point2D{srid, x, y} =
    PsStructure sigPoint2D $ V.fromList [toPs srid, toPs x, toPs y]
  fromPs (PsStructure t fs) | t == sigPoint2D, V.length fs == 3 =
    Point2D <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2)
  fromPs other = typeMismatch "Point2D" other


-- | A 3D spatial point.
type Point3D :: Type
data Point3D = Point3D
  { srid :: !Int64
  -- ^ Spatial Reference Identifier (e.g. 4979 for WGS-84-3D).
  , x    :: !Double
  , y    :: !Double
  , z    :: !Double
  }
  deriving stock (Show, Eq, Generic)
instance PackStream Point3D where
  toPs Point3D{srid, x, y, z} =
    PsStructure sigPoint3D $ V.fromList [toPs srid, toPs x, toPs y, toPs z]
  fromPs (PsStructure t fs) | t == sigPoint3D, V.length fs == 4 =
    Point3D <$> fromPs (fs V.! 0) <*> fromPs (fs V.! 1) <*> fromPs (fs V.! 2) <*> fromPs (fs V.! 3)
  fromPs other = typeMismatch "Point3D" other


-- = Bolt value extractors

-- | Extract a null value.
asNull :: Bolt -> Maybe ()
asNull BoltNull = Just ()
asNull _        = Nothing

-- | Extract a boolean value.
asBool :: Bolt -> Maybe Bool
asBool (BoltBoolean b) = Just b
asBool _               = Nothing

-- | Extract an integer value.
asInt :: Bolt -> Maybe PSInteger
asInt (BoltInteger i) = Just i
asInt _               = Nothing

-- | Extract a floating-point value.
asFloat :: Bolt -> Maybe Double
asFloat (BoltFloat d) = Just d
asFloat _             = Nothing

-- | Extract a byte string value.
asBytes :: Bolt -> Maybe BS.ByteString
asBytes (BoltBytes b) = Just b
asBytes _             = Nothing

-- | Extract a text value.
asText :: Bolt -> Maybe T.Text
asText (BoltString t) = Just t
asText _              = Nothing

-- | Extract a list value.
asList :: Bolt -> Maybe (V.Vector Bolt)
asList (BoltList v) = Just v
asList _            = Nothing

-- | Extract a dictionary value.
asDict :: Bolt -> Maybe (H.HashMap T.Text Bolt)
asDict (BoltDictionary m) = Just m
asDict _                  = Nothing

-- | Extract a node value.
asNode :: Bolt -> Maybe Node
asNode (BoltNode n) = Just n
asNode _            = Nothing

-- | Extract a relationship value.
asRelationship :: Bolt -> Maybe Relationship
asRelationship (BoltRelationship r) = Just r
asRelationship _                    = Nothing

-- | Extract a path value.
asPath :: Bolt -> Maybe Path
asPath (BoltPath p) = Just p
asPath _            = Nothing