Skip to content

Commit

Permalink
Version 0.0.1.9: add more HasCallStack & make any ToValue - IsValue v…
Browse files Browse the repository at this point in the history
…ia "derivining via" (#46)
  • Loading branch information
oddsome authored Mar 15, 2022
1 parent e1ed1dd commit 6562ce1
Show file tree
Hide file tree
Showing 7 changed files with 61 additions and 40 deletions.
5 changes: 5 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,11 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.

## [Unreleased]

## [0.0.1.9] - 2022-03-14
### Added
- `IsValue` instances for `ToValue` & `NodeLike` via newtypes;
- Add even more `HasCallStack`.

## [0.0.1.8] - 2021-09-07
### Added
- `FromValue` / `ToValue` instances for `NonEmpty`;
Expand Down
8 changes: 4 additions & 4 deletions hasbolt-extras.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: hasbolt-extras
version: 0.0.1.8
version: 0.0.1.9
synopsis: Extras for hasbolt library
description: Extras for hasbolt library
homepage: https://github.com/biocad/hasbolt-extras#readme
Expand Down Expand Up @@ -59,13 +59,13 @@ library
, Database.Bolt.Extras.Graph.Internal.Get
, Database.Bolt.Extras.Graph.Internal.Put
, Database.Bolt.Extras.Graph.Internal.GraphQuery

build-depends: base >= 4.8 && <5
, aeson >= 1.2.4.0
, aeson-casing >= 0.1.0.5
, containers >= 0.5.10.2
, free >= 5.0
, hasbolt >= 0.1.4.0
, hasbolt >= 0.1.6.1
, lens >= 4.16
, mtl >= 2.2.0
, neat-interpolation >= 0.3.2.0
Expand Down Expand Up @@ -98,7 +98,7 @@ test-suite doctest
hs-source-dirs: test
main-is: Doctest.hs

build-depends: base >= 4.8 && < 5
build-depends: base >= 4.8 && < 5
, hasbolt-extras
, doctest >= 0.16

Expand Down
16 changes: 8 additions & 8 deletions src/Database/Bolt/Extras/DSL/Internal/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,12 +29,12 @@ module Database.Bolt.Extras.DSL.Internal.Types
, toRelSelector
) where

import Data.Foldable (foldl')
import Data.Map.Strict (toList)
import Data.Text (Text)
import Database.Bolt (Node (..), URelationship (..),
Value (..))
import Database.Bolt.Extras (BoltId)
import Data.Foldable (foldl')
import Data.Map.Strict (toList)
import Data.Text (Text)
import Database.Bolt (Node (..), URelationship (..), Value (..))
import Database.Bolt.Extras (BoltId)
import GHC.Stack (HasCallStack)

-- | Class for Selectors, which can update identifier, labels and props.
--
Expand Down Expand Up @@ -171,12 +171,12 @@ defaultRel = RelSelector Nothing "" [] []
defR :: RelSelector
defR = defaultRel

toNodeSelector :: Node -> NodeSelector
toNodeSelector :: HasCallStack => Node -> NodeSelector
toNodeSelector Node{..} = defaultNode { nodeLabels = labels
, nodeProperties = filter ((/= N ()) . snd) (toList nodeProps)
}

toRelSelector :: URelationship -> RelSelector
toRelSelector :: HasCallStack => URelationship -> RelSelector
toRelSelector URelationship{..} = defaultRel { relLabel = urelType
, relProperties = toList urelProps
}
17 changes: 8 additions & 9 deletions src/Database/Bolt/Extras/DSL/Typed/Parameters.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,14 +11,13 @@
module Database.Bolt.Extras.DSL.Typed.Parameters
where

import Control.Monad.IO.Class (MonadIO)
import Data.Kind (Type)
import qualified Data.Map.Strict as Map
import Data.Text (Text, pack)
import Database.Bolt (BoltActionT, IsValue (..), Record,
Value, queryP)
import GHC.Stack (HasCallStack)
import GHC.TypeLits (Symbol)
import Control.Monad.IO.Class (MonadIO)
import Data.Kind (Type)
import qualified Data.Map.Strict as Map
import Data.Text (Text, pack)
import Database.Bolt (BoltActionT, IsValue (..), Record, Value, queryP)
import GHC.Stack (HasCallStack)
import GHC.TypeLits (Symbol)

import Database.Bolt.Extras.DSL.Internal.Executer (formQuery)
import Database.Bolt.Extras.DSL.Internal.Language (CypherDSL)
Expand Down Expand Up @@ -92,7 +91,7 @@ instance (IsValue typ, QueryWithParams rest m fun)
-- ...
queryWithParams
:: forall params m fun
. MonadIO m
. MonadIO m
=> QueryWithParams params m fun
=> HasCallStack
=> CypherDSLParams params ()
Expand Down
16 changes: 8 additions & 8 deletions src/Database/Bolt/Extras/Internal/Cypher.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,18 +15,18 @@ module Database.Bolt.Extras.Internal.Cypher
-- This file contains some converation rules from 'Database.Bolt' types to `Cypher`.
-------------------------------------------------------------------------------------------------

import Data.Text as T (Text, concat, cons,
intercalate, pack,
replace, toUpper)
import Database.Bolt (Value (..))
import Database.Bolt.Extras.Internal.Types (Label, Property)
import Database.Bolt.Extras.Utils (currentLoc)
import NeatInterpolation (text)
import Data.Text as T (Text, concat, cons, intercalate, pack, replace,
toUpper)
import Database.Bolt (Value (..))
import Database.Bolt.Extras.Internal.Types (Label, Property)
import Database.Bolt.Extras.Utils (currentLoc)
import GHC.Stack (HasCallStack)
import NeatInterpolation (text)

-- | The class for convertation into Cypher.
--
class ToCypher a where
toCypher :: a -> Text
toCypher :: HasCallStack => a -> Text

-- | Convertation for 'Database.Bolt.Value' into Cypher.
--
Expand Down
14 changes: 11 additions & 3 deletions src/Database/Bolt/Extras/Internal/Instances.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,11 @@ import Data.Aeson.Types (Parser)
import Data.List.NonEmpty (NonEmpty (..), toList)
import Data.Map.Strict (Map)
import Data.Text (Text)
import Database.Bolt (Node, Value (..))
import qualified Database.Bolt as DB (Structure)
import Database.Bolt.Extras.Internal.Types (FromValue (..), NodeLike (..), ToValue (..))
import Database.Bolt (Node (..), Value (..))
import qualified Database.Bolt as DB
import Database.Bolt.Extras.Internal.Types (FromValue (..), NodeLike (..),
NodeLikeProps (..), ToIsValue (..),
ToValue (..))
import Database.Bolt.Extras.Utils (currentLoc)
import GHC.Float (double2Float, float2Double)

Expand Down Expand Up @@ -55,6 +57,12 @@ instance ToValue (Map Text Value) where
instance ToValue DB.Structure where
toValue = S

instance ToValue a => DB.IsValue (ToIsValue a) where
toValue (ToIsValue a) = toValue a

instance NodeLike a => DB.IsValue (NodeLikeProps a) where
toValue (NodeLikeProps a) = toValue $ nodeProps $ toNode a

instance FromValue () where
fromValue (N ()) = ()
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into ()"
Expand Down
25 changes: 17 additions & 8 deletions src/Database/Bolt/Extras/Internal/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,11 @@ module Database.Bolt.Extras.Internal.Types
, Property
, ToValue (..)
, URelationLike (..)
, ToIsValue (..)
, NodeLikeProps (..)
) where

import GHC.Stack (HasCallStack)
import Data.Map.Strict (Map)
import Data.Text (Text)
import Database.Bolt (Node (..), URelationship (..), Value (..))
Expand All @@ -25,29 +28,29 @@ type Property = (Text, Value)
-- | 'NodeLike' class represents convertable into and from 'Node'.
--
class NodeLike a where
toNode :: a -> Node
fromNode :: Node -> a
toNode :: HasCallStack => a -> Node
fromNode :: HasCallStack => Node -> a

-- | 'URelationLike' class represents convertable into and from 'URelationship'.
--
class URelationLike a where
toURelation :: a -> URelationship
fromURelation :: URelationship -> a
toURelation :: HasCallStack => a -> URelationship
fromURelation :: HasCallStack => URelationship -> a

-- | 'ToValue' means that something can be converted into Bolt 'Value'.
--
class ToValue a where
toValue :: a -> Value
toValue :: HasCallStack => a -> Value

-- | 'FromValue' means that something can be converted from Bolt 'Value'.
--
class FromValue a where
fromValue :: Value -> a
fromValue :: HasCallStack => Value -> a

-- | 'Labels' means that labels can be obtained from entity.
--
class Labels a where
getLabels :: a -> [Label]
getLabels :: HasCallStack => a -> [Label]

instance Labels Node where
getLabels = labels
Expand All @@ -58,10 +61,16 @@ instance Labels URelationship where
-- | 'Properties' means that properties can be obtained from entity.
--
class Properties a where
getProps :: a -> Map Text Value
getProps :: HasCallStack => a -> Map Text Value

instance Properties Node where
getProps = nodeProps

instance Properties URelationship where
getProps = urelProps

-- | ToIsValue provides IsValue instance given ToValue
newtype ToIsValue a = ToIsValue a

-- | NodeLikeProps provides IsValue instance given NodeLike, in form of Map Text Value
newtype NodeLikeProps a = NodeLikeProps a

0 comments on commit 6562ce1

Please sign in to comment.