Skip to content

Commit d3f78a8

Browse files
maksbotanmaksbotan
authored
Merge pull request #55 from biocad/maksbotan/hascallstack
version 0.0.2.2: add HasCallStack
2 parents 6652c6a + 3ffe623 commit d3f78a8

File tree

9 files changed

+72
-52
lines changed

9 files changed

+72
-52
lines changed

‎.github/workflows/haskell-ci.yml‎

Lines changed: 20 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,9 @@
88
#
99
# For more information, see https://github.com/haskell-CI/haskell-ci
1010
#
11-
# version: 0.14.3
11+
# version: 0.16
1212
#
13-
# REGENDATA ("0.14.3",["github","hasbolt-extras.cabal"])
13+
# REGENDATA ("0.16",["github","hasbolt-extras.cabal"])
1414
#
1515
name: Haskell-CI
1616
on:
@@ -23,7 +23,7 @@ on:
2323
jobs:
2424
linux:
2525
name: Haskell-CI - Linux - ${{ matrix.compiler }}
26-
runs-on: ubuntu-18.04
26+
runs-on: ubuntu-20.04
2727
timeout-minutes:
2828
60
2929
container:
@@ -32,14 +32,19 @@ jobs:
3232
strategy:
3333
matrix:
3434
include:
35+
- compiler: ghc-9.6.1
36+
compilerKind: ghc
37+
compilerVersion: 9.6.1
38+
setup-method: ghcup
39+
allow-failure: true
3540
- compiler: ghc-9.4.4
3641
compilerKind: ghc
3742
compilerVersion: 9.4.4
3843
setup-method: ghcup
3944
allow-failure: true
40-
- compiler: ghc-9.2.5
45+
- compiler: ghc-9.2.7
4146
compilerKind: ghc
42-
compilerVersion: 9.2.5
47+
compilerVersion: 9.2.7
4348
setup-method: ghcup
4449
allow-failure: true
4550
- compiler: ghc-9.0.2
@@ -70,18 +75,18 @@ jobs:
7075
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
7176
if [ "${{ matrix.setup-method }}" = ghcup ]; then
7277
mkdir -p "$HOME/.ghcup/bin"
73-
curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
78+
curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"
7479
chmod a+x "$HOME/.ghcup/bin/ghcup"
75-
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
76-
"$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
80+
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
81+
"$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
7782
else
7883
apt-add-repository -y 'ppa:hvr/ghc'
7984
apt-get update
8085
apt-get install -y "$HCNAME"
8186
mkdir -p "$HOME/.ghcup/bin"
82-
curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
87+
curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"
8388
chmod a+x "$HOME/.ghcup/bin/ghcup"
84-
"$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
89+
"$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
8590
fi
8691
env:
8792
HCKIND: ${{ matrix.compilerKind }}
@@ -99,13 +104,13 @@ jobs:
99104
echo "HC=$HC" >> "$GITHUB_ENV"
100105
echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
101106
echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
102-
echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
107+
echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
103108
else
104109
HC=$HCDIR/bin/$HCKIND
105110
echo "HC=$HC" >> "$GITHUB_ENV"
106111
echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
107112
echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
108-
echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
113+
echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
109114
fi
110115
111116
HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
@@ -157,8 +162,8 @@ jobs:
157162
- name: install cabal-plan
158163
run: |
159164
mkdir -p $HOME/.cabal/bin
160-
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
161-
echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
165+
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
166+
echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
162167
xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
163168
rm -f cabal-plan.xz
164169
chmod a+x $HOME/.cabal/bin/cabal-plan
@@ -220,7 +225,7 @@ jobs:
220225
$CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
221226
- name: haddock
222227
run: |
223-
$CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
228+
$CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
224229
- name: unconstrained build
225230
run: |
226231
rm -f cabal.project.local

‎CHANGELOG.md‎

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

77
## [Unreleased]
88

9+
## [0.0.2.2] - 2023-05-05
10+
### Changed
11+
- Add `HasCallStack` to a lot of unpacking functions.
12+
913
## [0.0.2.1] - 2023-01-24
1014
### Added
11-
- Add newline for Cyper queries.
15+
- Add newline for Cypher queries.
16+
1217
## [0.0.2.0] - 2023-01-24
1318
### Added
1419
- `BoltGeneric` wrapper for `DerivingVia` to derive `IsValue` and `RecordValue` for Haskell types.

‎hasbolt-extras.cabal‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: hasbolt-extras
2-
version: 0.0.2.1
2+
version: 0.0.2.2
33
synopsis: Extras for hasbolt library
44
description: Extras for hasbolt library
55
homepage: https://github.com/biocad/hasbolt-extras#readme
@@ -22,8 +22,9 @@ tested-with:
2222
|| ==8.8.4
2323
|| ==8.10.7
2424
|| ==9.0.2
25-
|| ==9.2.5
25+
|| ==9.2.7
2626
|| ==9.4.4
27+
|| ==9.6.1
2728

2829
source-repository head
2930
type: git

‎src/Database/Bolt/Extras/Graph/Internal/Class.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module Database.Bolt.Extras.Graph.Internal.Class
88
import Control.Monad.IO.Class (MonadIO)
99
import Data.Text (Text)
1010
import Database.Bolt (BoltActionT, Record)
11+
import GHC.Stack (HasCallStack)
1112

1213
-- | Entity which can be requested from Neo4j in @MATCH@ operator.
1314
--
@@ -27,4 +28,4 @@ class Returnable a where
2728
-- | Entity which can be extracted from 'Record' by its name.
2829
--
2930
class Extractable a where
30-
extract :: MonadIO m => Text -> [Record] -> BoltActionT m [a]
31+
extract :: (HasCallStack, MonadIO m) => Text -> [Record] -> BoltActionT m [a]

‎src/Database/Bolt/Extras/Graph/Internal/Get.hs‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,7 @@ import Database.Bolt.Extras.Graph.Internal.Class (Extractable
8989
Requestable (..),
9090
Returnable (..))
9191
import GHC.Generics (Generic)
92+
import GHC.Stack (HasCallStack)
9293
import Language.Haskell.TH.Syntax (Name,
9394
nameBase)
9495
import NeatInterpolation (text)
@@ -301,7 +302,7 @@ instance Extractable NodeResult where
301302
instance Extractable RelResult where
302303
extract = extractFromJSON
303304

304-
extractFromJSON :: (MonadIO m, FromJSON a) => Text -> [Record] -> BoltActionT m [a]
305+
extractFromJSON :: (HasCallStack, MonadIO m, FromJSON a) => Text -> [Record] -> BoltActionT m [a]
305306
extractFromJSON var = pure . fmap (\r -> case fromJSON (toJSON (r ! var)) of
306307
Success parsed -> parsed
307308
Error err -> error err)
@@ -333,38 +334,38 @@ type GraphGetResponse = Graph NodeName NodeResult RelResult
333334

334335
-- | Extract a node by its name from 'GraphGetResponse' and convert it to user type
335336
-- with 'fromNode'.
336-
extractNode :: NodeLike a => NodeName -> GraphGetResponse -> a
337+
extractNode :: HasCallStack => NodeLike a => NodeName -> GraphGetResponse -> a
337338
extractNode var graph = graph ^. vertices . at var . non (errorForNode var) . to (fromNode . toNode)
338339

339340
-- | Extract a relation by name of it start and end nodes and convert to user type with 'fromURelation'.
340-
extractRelation :: URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a
341+
extractRelation :: HasCallStack => URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a
341342
extractRelation stVar enVar graph = graph ^. relations . at (stVar, enVar)
342343
. non (errorForRelation stVar enVar)
343344
. to (fromURelation . toURelation)
344345

345346
-- | Extract just node's 'BoltId'.
346-
extractNodeId :: NodeName -> GraphGetResponse -> BoltId
347+
extractNodeId :: HasCallStack => NodeName -> GraphGetResponse -> BoltId
347348
extractNodeId var graph = graph ^. vertices . at var . non (errorForNode var) . to nresId
348349

349350
-- | Extract just relation's 'BoltId'.
350-
extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId
351+
extractRelationId :: HasCallStack => NodeName -> NodeName -> GraphGetResponse -> BoltId
351352
extractRelationId stVar enVar graph = graph ^. relations . at (stVar, enVar)
352353
. non (errorForRelation stVar enVar)
353354
. to rresId
354355

355356
-- | Extract 'NodeResult'.
356-
extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult
357+
extractNodeAeson :: HasCallStack => NodeName -> GraphGetResponse -> NodeResult
357358
extractNodeAeson var graph = graph ^. vertices . at var . non (errorForNode var)
358359

359360
-- | Extract 'RelResult'.
360-
extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult
361+
extractRelationAeson :: HasCallStack => NodeName -> NodeName -> GraphGetResponse -> RelResult
361362
extractRelationAeson stVar enVar graph = graph ^. relations . at (stVar, enVar)
362363
. non (errorForRelation stVar enVar)
363364

364-
errorForNode :: NodeName -> a
365+
errorForNode :: HasCallStack => NodeName -> a
365366
errorForNode name = error . unpack $ "node with name " <> name <> " doesn't exist"
366367

367-
errorForRelation :: NodeName -> NodeName -> a
368+
errorForRelation :: HasCallStack => NodeName -> NodeName -> a
368369
errorForRelation stName enName = error . unpack $ "relation between nodes " <>
369370
stName <> " and " <> enName <>
370371
" doesn't exist"

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

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,13 @@
22
{-# LANGUAGE OverloadedStrings #-}
33
{-# LANGUAGE TemplateHaskell #-}
44
{-# OPTIONS_GHC -fno-warn-orphans #-}
5+
{-# LANGUAGE InstanceSigs #-}
56

67
module Database.Bolt.Extras.Internal.Instances () where
78

89
import Control.Applicative ((<|>))
910
import Data.Aeson (FromJSON (..), ToJSON (..))
11+
import qualified Data.Aeson as A
1012
import Data.Aeson.Types (Parser)
1113
import Data.List.NonEmpty (NonEmpty (..), toList)
1214
import Data.Map.Strict (Map)
@@ -18,6 +20,7 @@ import Database.Bolt.Extras.Internal.Types (FromValue (..), NodeLike (
1820
ToValue (..))
1921
import Database.Bolt.Extras.Utils (currentLoc)
2022
import GHC.Float (double2Float, float2Double)
23+
import GHC.Stack (HasCallStack)
2124

2225

2326
instance ToValue () where
@@ -69,30 +72,30 @@ instance FromValue () where
6972

7073
instance FromValue Bool where
7174
fromValue (B boolV) = boolV
72-
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Bool"
75+
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Bool"
7376

7477
instance FromValue Int where
7578
fromValue (I intV) = intV
76-
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Int"
79+
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Int"
7780

7881
instance FromValue Double where
7982
fromValue (F doubleV) = doubleV
80-
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Double"
83+
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Double"
8184

8285
instance FromValue Float where
8386
fromValue (F doubleV) = double2Float doubleV
84-
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Float"
87+
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Float"
8588

8689
instance FromValue Text where
8790
fromValue (T textV) = textV
88-
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Text"
91+
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Text"
8992

9093
instance FromValue Value where
9194
fromValue = id
9295

9396
instance FromValue a => FromValue [a] where
9497
fromValue (L listV) = fmap fromValue listV
95-
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into [Value]"
98+
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into [Value]"
9699

97100
instance FromValue a => FromValue (NonEmpty a) where
98101
fromValue v =
@@ -113,6 +116,7 @@ instance FromValue DB.Structure where
113116
fromValue v = error $ $currentLoc ++ "could not unpack " ++ show v ++ " into Structure"
114117

115118
instance ToJSON Value where
119+
toJSON :: HasCallStack => Value -> A.Value
116120
toJSON (N _) = toJSON ()
117121
toJSON (B b) = toJSON b
118122
toJSON (I i) = toJSON i
@@ -123,6 +127,7 @@ instance ToJSON Value where
123127
toJSON _ = error "Database.Bolt.Extras.Internal.Instances: could not convert to json Database.Bolt.Value"
124128

125129
instance FromJSON Value where
130+
parseJSON :: HasCallStack => A.Value -> Parser Value
126131
parseJSON v = B <$> (parseJSON v :: Parser Bool)
127132
<|> I <$> (parseJSON v :: Parser Int)
128133
<|> F <$> (parseJSON v :: Parser Double)

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

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ import Data.Aeson.Casing (aesonPrefix, snakeCase)
1515
import Database.Bolt (Node (..), Relationship (..),
1616
URelationship (..))
1717
import GHC.Generics (Generic (..))
18+
import GHC.Stack (HasCallStack)
1819

1920
-- | 'BoltId' is alias for Bolt 'Node', 'Relationship' and 'URelationship' identities.
2021
--
@@ -28,14 +29,14 @@ data Persisted a = Persisted { objectId :: BoltId
2829

2930
-- | This is just check that your 'BoltId' is valid.
3031
--
31-
fromInt :: Int -> BoltId
32+
fromInt :: HasCallStack => Int -> BoltId
3233
fromInt i | i >= 0 = i
3334
| otherwise = error "Database.Bolt.Extras.Internal.Persisted: could not create BoltId with identity less then zero."
3435

3536
-- | Common class to get 'BoltId' from the object.
3637
--
3738
class GetBoltId a where
38-
getBoltId :: a -> BoltId
39+
getBoltId :: HasCallStack => a -> BoltId
3940

4041
instance GetBoltId Node where
4142
getBoltId = fromInt . nodeIdentity

‎src/Database/Bolt/Extras/Template/Internal/Converters.hs‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import Database.Bolt.Extras.Utils (currentLoc, dummyId)
2121
import Instances.TH.Lift ()
2222
import Language.Haskell.TH
2323
import Language.Haskell.TH.Syntax
24+
import GHC.Stack (HasCallStack)
2425

2526
-- Starting with template-haskell-2.16.0.0, 'TupE' constructor accepts @Maybe Exp@, to support
2627
-- TupleSections. We use this alias for compatibility with both old and new versions.
@@ -99,7 +100,7 @@ uRelationLikeClass = BiClassInfo { className = ''URelationLike
99100
--
100101
-- >>> fromNode barNode :: Foo
101102
-- Bar {baz = 42.0, quux = "Hello world", quuz = Nothing}
102-
makeNodeLike :: Name -> Q [Dec]
103+
makeNodeLike :: HasCallStack => Name -> Q [Dec]
103104
makeNodeLike name = makeBiClassInstance nodeLikeClass name id
104105

105106
-- | The same as 'makeNodeLike', but applies a function to all field names before storing them
@@ -109,18 +110,18 @@ makeNodeLike name = makeBiClassInstance nodeLikeClass name id
109110
--
110111
-- > makeNodeLikeWith ''Foo $ fieldLabelModifier $ aesonPrefix camelCase
111112
--
112-
makeNodeLikeWith :: Name -> (String -> String) -> Q [Dec]
113+
makeNodeLikeWith :: HasCallStack => Name -> (String -> String) -> Q [Dec]
113114
makeNodeLikeWith = makeBiClassInstance nodeLikeClass
114115

115116
-- | Make an instance of 'URelationLike' class.
116117
-- Transformations are the same as in 'NodeLike' instance declaration with the only one difference:
117118
-- 'URelationship' holds only one label (or type), but 'Node' holds list of labels.
118119
--
119-
makeURelationLike :: Name -> Q [Dec]
120+
makeURelationLike :: HasCallStack => Name -> Q [Dec]
120121
makeURelationLike name = makeBiClassInstance uRelationLikeClass name id
121122

122123
-- | As 'makeNodeLikeWith'.
123-
makeURelationLikeWith :: Name -> (String -> String) -> Q [Dec]
124+
makeURelationLikeWith :: HasCallStack => Name -> (String -> String) -> Q [Dec]
124125
makeURelationLikeWith = makeBiClassInstance uRelationLikeClass
125126

126127
-- | Declare an instance of `bijective` class using TemplateHaskell.
@@ -152,7 +153,7 @@ makeURelationLikeWith = makeBiClassInstance uRelationLikeClass
152153
-- > , nodeProps = fromList [("specie", T "text value"), ("vgen", F %float_value), ("fr", F %float_value), ("sim", F %float_value), ("germline", T "text value")]
153154
-- > }
154155
--
155-
makeBiClassInstance :: BiClassInfo -> Name -> (String -> String) -> Q [Dec]
156+
makeBiClassInstance :: HasCallStack => BiClassInfo -> Name -> (String -> String) -> Q [Dec]
156157
makeBiClassInstance BiClassInfo {..} typeCon fieldLabelModifier = do
157158
-- reify function gives Info about Name such as constructor name and its fields. See: https://hackage.haskell.org/package/template-haskell-2.12.0.0/docs/Language-Haskell-TH.html#t:Info
158159
TyConI declaration <- reify typeCon
@@ -184,7 +185,7 @@ makeBiClassInstance BiClassInfo {..} typeCon fieldLabelModifier = do
184185

185186
-- | Extract information about type: constructor name and field record names with corresponding types.
186187
--
187-
getConsFields :: Con -> (Name, [(Name, Type)])
188+
getConsFields :: HasCallStack => Con -> (Name, [(Name, Type)])
188189
getConsFields (RecC cName decs) = (cName, fmap (\(fname, _, ftype) -> (fname, ftype)) decs)
189190
getConsFields (ForallC _ _ cons) = getConsFields cons
190191
getConsFields (RecGadtC (cName:_) decs _) = (cName, fmap (\(fname, _, ftype) -> (fname, ftype)) decs)
@@ -194,7 +195,7 @@ getConsFields _ = error $ $currentLoc ++ "unsupported
194195

195196
-- | Parse a type declaration and retrieve its name and its constructors.
196197
--
197-
getTypeCons :: Dec -> (Name, [Con])
198+
getTypeCons :: HasCallStack => Dec -> (Name, [Con])
198199
getTypeCons (DataD _ typeName _ _ constructors _) = (typeName, constructors)
199200
getTypeCons (NewtypeD _ typeName _ _ constructor _) = (typeName, [constructor])
200201
getTypeCons otherDecl = error $ $currentLoc ++ "unsupported declaration: " ++ show otherDecl ++ "\nShould be either 'data' or 'newtype'."
@@ -316,15 +317,15 @@ checkProps container = all (\(fieldName, fieldMaybe) -> fieldMaybe || fieldName
316317
checkLabels :: Labels t => t -> [Text] -> Bool
317318
checkLabels container = all (`elem` getLabels container)
318319

319-
getProp :: (Properties t, RecordValue a) => t -> (Text, Bool) -> a
320+
getProp :: (HasCallStack, Properties t, RecordValue a) => t -> (Text, Bool) -> a
320321
getProp container (fieldName, fieldMaybe) | fieldMaybe && fieldName `notMember` getProps container = exactE $ N ()
321322
| otherwise = exactE (getProps container ! fieldName)
322323
where
323324
exactE v = case exactEither v of
324325
Right res -> res
325326
Left err -> error $ show err
326327

327-
unpackError :: Show c => c -> String -> a
328+
unpackError :: HasCallStack => Show c => c -> String -> a
328329
unpackError container label = error $ $currentLoc ++ " could not unpack " ++ label ++ " from " ++ show container
329330

330331
{- $setup

0 commit comments

Comments
 (0)