Skip to content

Commit 6562ce1

Browse files
oddsomeoddsome
authored
Version 0.0.1.9: add more HasCallStack & make any ToValue - IsValue via "derivining via" (#46)
1 parent e1ed1dd commit 6562ce1

File tree

7 files changed

+61
-40
lines changed

7 files changed

+61
-40
lines changed

‎CHANGELOG.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,11 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
66

77
## [Unreleased]
88

9+
## [0.0.1.9] - 2022-03-14
10+
### Added
11+
- `IsValue` instances for `ToValue` & `NodeLike` via newtypes;
12+
- Add even more `HasCallStack`.
13+
914
## [0.0.1.8] - 2021-09-07
1015
### Added
1116
- `FromValue` / `ToValue` instances for `NonEmpty`;

‎hasbolt-extras.cabal‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: hasbolt-extras
2-
version: 0.0.1.8
2+
version: 0.0.1.9
33
synopsis: Extras for hasbolt library
44
description: Extras for hasbolt library
55
homepage: https://github.com/biocad/hasbolt-extras#readme
@@ -59,13 +59,13 @@ library
5959
, Database.Bolt.Extras.Graph.Internal.Get
6060
, Database.Bolt.Extras.Graph.Internal.Put
6161
, Database.Bolt.Extras.Graph.Internal.GraphQuery
62-
62+
6363
build-depends: base >= 4.8 && <5
6464
, aeson >= 1.2.4.0
6565
, aeson-casing >= 0.1.0.5
6666
, containers >= 0.5.10.2
6767
, free >= 5.0
68-
, hasbolt >= 0.1.4.0
68+
, hasbolt >= 0.1.6.1
6969
, lens >= 4.16
7070
, mtl >= 2.2.0
7171
, neat-interpolation >= 0.3.2.0
@@ -98,7 +98,7 @@ test-suite doctest
9898
hs-source-dirs: test
9999
main-is: Doctest.hs
100100

101-
build-depends: base >= 4.8 && < 5
101+
build-depends: base >= 4.8 && < 5
102102
, hasbolt-extras
103103
, doctest >= 0.16
104104

‎src/Database/Bolt/Extras/DSL/Internal/Types.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -29,12 +29,12 @@ module Database.Bolt.Extras.DSL.Internal.Types
2929
, toRelSelector
3030
) where
3131

32-
import Data.Foldable (foldl')
33-
import Data.Map.Strict (toList)
34-
import Data.Text (Text)
35-
import Database.Bolt (Node (..), URelationship (..),
36-
Value (..))
37-
import Database.Bolt.Extras (BoltId)
32+
import Data.Foldable (foldl')
33+
import Data.Map.Strict (toList)
34+
import Data.Text (Text)
35+
import Database.Bolt (Node (..), URelationship (..), Value (..))
36+
import Database.Bolt.Extras (BoltId)
37+
import GHC.Stack (HasCallStack)
3838

3939
-- | Class for Selectors, which can update identifier, labels and props.
4040
--
@@ -171,12 +171,12 @@ defaultRel = RelSelector Nothing "" [] []
171171
defR :: RelSelector
172172
defR = defaultRel
173173

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

179-
toRelSelector :: URelationship -> RelSelector
179+
toRelSelector :: HasCallStack => URelationship -> RelSelector
180180
toRelSelector URelationship{..} = defaultRel { relLabel = urelType
181181
, relProperties = toList urelProps
182182
}

‎src/Database/Bolt/Extras/DSL/Typed/Parameters.hs‎

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -11,14 +11,13 @@
1111
module Database.Bolt.Extras.DSL.Typed.Parameters
1212
where
1313

14-
import Control.Monad.IO.Class (MonadIO)
15-
import Data.Kind (Type)
16-
import qualified Data.Map.Strict as Map
17-
import Data.Text (Text, pack)
18-
import Database.Bolt (BoltActionT, IsValue (..), Record,
19-
Value, queryP)
20-
import GHC.Stack (HasCallStack)
21-
import GHC.TypeLits (Symbol)
14+
import Control.Monad.IO.Class (MonadIO)
15+
import Data.Kind (Type)
16+
import qualified Data.Map.Strict as Map
17+
import Data.Text (Text, pack)
18+
import Database.Bolt (BoltActionT, IsValue (..), Record, Value, queryP)
19+
import GHC.Stack (HasCallStack)
20+
import GHC.TypeLits (Symbol)
2221

2322
import Database.Bolt.Extras.DSL.Internal.Executer (formQuery)
2423
import Database.Bolt.Extras.DSL.Internal.Language (CypherDSL)
@@ -92,7 +91,7 @@ instance (IsValue typ, QueryWithParams rest m fun)
9291
-- ...
9392
queryWithParams
9493
:: forall params m fun
95-
. MonadIO m
94+
. MonadIO m
9695
=> QueryWithParams params m fun
9796
=> HasCallStack
9897
=> CypherDSLParams params ()

‎src/Database/Bolt/Extras/Internal/Cypher.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -15,18 +15,18 @@ module Database.Bolt.Extras.Internal.Cypher
1515
-- This file contains some converation rules from 'Database.Bolt' types to `Cypher`.
1616
-------------------------------------------------------------------------------------------------
1717

18-
import Data.Text as T (Text, concat, cons,
19-
intercalate, pack,
20-
replace, toUpper)
21-
import Database.Bolt (Value (..))
22-
import Database.Bolt.Extras.Internal.Types (Label, Property)
23-
import Database.Bolt.Extras.Utils (currentLoc)
24-
import NeatInterpolation (text)
18+
import Data.Text as T (Text, concat, cons, intercalate, pack, replace,
19+
toUpper)
20+
import Database.Bolt (Value (..))
21+
import Database.Bolt.Extras.Internal.Types (Label, Property)
22+
import Database.Bolt.Extras.Utils (currentLoc)
23+
import GHC.Stack (HasCallStack)
24+
import NeatInterpolation (text)
2525

2626
-- | The class for convertation into Cypher.
2727
--
2828
class ToCypher a where
29-
toCypher :: a -> Text
29+
toCypher :: HasCallStack => a -> Text
3030

3131
-- | Convertation for 'Database.Bolt.Value' into Cypher.
3232
--

‎src/Database/Bolt/Extras/Internal/Instances.hs‎

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,9 +11,11 @@ import Data.Aeson.Types (Parser)
1111
import Data.List.NonEmpty (NonEmpty (..), toList)
1212
import Data.Map.Strict (Map)
1313
import Data.Text (Text)
14-
import Database.Bolt (Node, Value (..))
15-
import qualified Database.Bolt as DB (Structure)
16-
import Database.Bolt.Extras.Internal.Types (FromValue (..), NodeLike (..), ToValue (..))
14+
import Database.Bolt (Node (..), Value (..))
15+
import qualified Database.Bolt as DB
16+
import Database.Bolt.Extras.Internal.Types (FromValue (..), NodeLike (..),
17+
NodeLikeProps (..), ToIsValue (..),
18+
ToValue (..))
1719
import Database.Bolt.Extras.Utils (currentLoc)
1820
import GHC.Float (double2Float, float2Double)
1921

@@ -55,6 +57,12 @@ instance ToValue (Map Text Value) where
5557
instance ToValue DB.Structure where
5658
toValue = S
5759

60+
instance ToValue a => DB.IsValue (ToIsValue a) where
61+
toValue (ToIsValue a) = toValue a
62+
63+
instance NodeLike a => DB.IsValue (NodeLikeProps a) where
64+
toValue (NodeLikeProps a) = toValue $ nodeProps $ toNode a
65+
5866
instance FromValue () where
5967
fromValue (N ()) = ()
6068
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into ()"

‎src/Database/Bolt/Extras/Internal/Types.hs‎

Lines changed: 17 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,11 @@ module Database.Bolt.Extras.Internal.Types
88
, Property
99
, ToValue (..)
1010
, URelationLike (..)
11+
, ToIsValue (..)
12+
, NodeLikeProps (..)
1113
) where
1214

15+
import GHC.Stack (HasCallStack)
1316
import Data.Map.Strict (Map)
1417
import Data.Text (Text)
1518
import Database.Bolt (Node (..), URelationship (..), Value (..))
@@ -25,29 +28,29 @@ type Property = (Text, Value)
2528
-- | 'NodeLike' class represents convertable into and from 'Node'.
2629
--
2730
class NodeLike a where
28-
toNode :: a -> Node
29-
fromNode :: Node -> a
31+
toNode :: HasCallStack => a -> Node
32+
fromNode :: HasCallStack => Node -> a
3033

3134
-- | 'URelationLike' class represents convertable into and from 'URelationship'.
3235
--
3336
class URelationLike a where
34-
toURelation :: a -> URelationship
35-
fromURelation :: URelationship -> a
37+
toURelation :: HasCallStack => a -> URelationship
38+
fromURelation :: HasCallStack => URelationship -> a
3639

3740
-- | 'ToValue' means that something can be converted into Bolt 'Value'.
3841
--
3942
class ToValue a where
40-
toValue :: a -> Value
43+
toValue :: HasCallStack => a -> Value
4144

4245
-- | 'FromValue' means that something can be converted from Bolt 'Value'.
4346
--
4447
class FromValue a where
45-
fromValue :: Value -> a
48+
fromValue :: HasCallStack => Value -> a
4649

4750
-- | 'Labels' means that labels can be obtained from entity.
4851
--
4952
class Labels a where
50-
getLabels :: a -> [Label]
53+
getLabels :: HasCallStack => a -> [Label]
5154

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

6366
instance Properties Node where
6467
getProps = nodeProps
6568

6669
instance Properties URelationship where
6770
getProps = urelProps
71+
72+
-- | ToIsValue provides IsValue instance given ToValue
73+
newtype ToIsValue a = ToIsValue a
74+
75+
-- | NodeLikeProps provides IsValue instance given NodeLike, in form of Map Text Value
76+
newtype NodeLikeProps a = NodeLikeProps a

0 commit comments

Comments
 (0)