diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,11 @@ ## [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`; diff --git a/hasbolt-extras.cabal b/hasbolt-extras.cabal --- a/hasbolt-extras.cabal +++ b/hasbolt-extras.cabal @@ -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 @@ -17,6 +17,13 @@ extra-source-files: CHANGELOG.md README.md +tested-with: + GHC ==8.6.5 + || ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.2 + source-repository head type: git location: https://github.com/biocad/hasbolt-extras @@ -52,13 +59,13 @@ , 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 @@ -91,7 +98,7 @@ 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 diff --git a/src/Database/Bolt/Extras/DSL/Internal/Types.hs b/src/Database/Bolt/Extras/DSL/Internal/Types.hs --- a/src/Database/Bolt/Extras/DSL/Internal/Types.hs +++ b/src/Database/Bolt/Extras/DSL/Internal/Types.hs @@ -29,12 +29,12 @@ , 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. -- @@ -171,12 +171,12 @@ 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 } diff --git a/src/Database/Bolt/Extras/DSL/Typed.hs b/src/Database/Bolt/Extras/DSL/Typed.hs --- a/src/Database/Bolt/Extras/DSL/Typed.hs +++ b/src/Database/Bolt/Extras/DSL/Typed.hs @@ -190,24 +190,19 @@ & withReturn allProps ) :} -MATCH (user)-[user0binder :USER_CREATED {}]->(binder) -, (binder :Binder {uuid:"123-456"}) -, (user :User {user:"098-765"}) +MATCH (user)-[user0binder :USER_CREATED {}]->(binder), (binder :Binder {uuid:"123-456"}), (user :User {user:"098-765"}) WITH DISTINCT binder, user, user0binder RETURN { id: id(binder), labels: labels(binder), props: properties(binder) -} as binder -, { id: id(user), +} as binder, { id: id(user), labels: labels(user), props: properties(user) -} as user -, { id: id(user0binder), +} as user, { id: id(user0binder), label: type(user0binder), props: properties(user0binder) } as user0binder - -} {- $safety diff --git a/src/Database/Bolt/Extras/DSL/Typed/Parameters.hs b/src/Database/Bolt/Extras/DSL/Typed/Parameters.hs --- a/src/Database/Bolt/Extras/DSL/Typed/Parameters.hs +++ b/src/Database/Bolt/Extras/DSL/Typed/Parameters.hs @@ -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) @@ -92,7 +91,7 @@ -- ... queryWithParams :: forall params m fun - . MonadIO m + . MonadIO m => QueryWithParams params m fun => HasCallStack => CypherDSLParams params () diff --git a/src/Database/Bolt/Extras/Internal/Cypher.hs b/src/Database/Bolt/Extras/Internal/Cypher.hs --- a/src/Database/Bolt/Extras/Internal/Cypher.hs +++ b/src/Database/Bolt/Extras/Internal/Cypher.hs @@ -15,18 +15,18 @@ -- 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. -- diff --git a/src/Database/Bolt/Extras/Internal/Instances.hs b/src/Database/Bolt/Extras/Internal/Instances.hs --- a/src/Database/Bolt/Extras/Internal/Instances.hs +++ b/src/Database/Bolt/Extras/Internal/Instances.hs @@ -11,9 +11,11 @@ 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) @@ -54,6 +56,12 @@ 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 ()) = () diff --git a/src/Database/Bolt/Extras/Internal/Types.hs b/src/Database/Bolt/Extras/Internal/Types.hs --- a/src/Database/Bolt/Extras/Internal/Types.hs +++ b/src/Database/Bolt/Extras/Internal/Types.hs @@ -8,8 +8,11 @@ , 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 (..)) @@ -25,29 +28,29 @@ -- | '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 @@ -58,10 +61,16 @@ -- | '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