]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Query/Table/Node/Error.hs
[ngrams] add r_history %~ mempty to ngrams POST
[gargantext.git] / src / Gargantext / Database / Query / Table / Node / Error.hs
1 {-|
2 Module : Gargantext.Database.Types.Error
3 Description :
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9 -}
10
11 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
13
14 {-# LANGUAGE Arrows #-}
15 {-# LANGUAGE ConstraintKinds #-}
16 {-# LANGUAGE FunctionalDependencies #-}
17 {-# LANGUAGE TemplateHaskell #-}
18 {-# LANGUAGE TypeFamilies #-}
19
20 module Gargantext.Database.Query.Table.Node.Error where
21
22 import Data.Text (Text)
23 import Gargantext.Database.Admin.Types.Node (NodeId)
24 import Control.Lens (Prism', (#), (^?))
25 import Control.Monad.Error.Class (MonadError(..))
26 import Gargantext.Prelude hiding (sum, head)
27 import Prelude hiding (null, id, map, sum)
28
29 ------------------------------------------------------------------------
30 data NodeError = NoListFound
31 | NoRootFound
32 | NoCorpusFound
33 | NoUserFound
34 | MkNode
35 | UserNoParent
36 | HasParent
37 | ManyParents
38 | NegativeId
39 | NotImplYet
40 | ManyNodeUsers
41 | DoesNotExist NodeId
42 | NeedsConfiguration
43 | NodeError Text
44
45 instance Show NodeError
46 where
47 show NoListFound = "No list found"
48 show NoRootFound = "No Root found"
49 show NoCorpusFound = "No Corpus found"
50 show NoUserFound = "No user found"
51
52 show MkNode = "Cannot make node"
53 show NegativeId = "Node with negative Id"
54 show UserNoParent = "Should not have parent"
55 show HasParent = "NodeType has parent"
56 show NotImplYet = "Not implemented yet"
57 show ManyParents = "Too many parents"
58 show ManyNodeUsers = "Many userNode/user"
59 show (DoesNotExist n) = "Node does not exist" <> show n
60 show NeedsConfiguration = "Needs configuration"
61 show (NodeError e) = "NodeError: " <> cs e
62
63 class HasNodeError e where
64 _NodeError :: Prism' e NodeError
65
66 errorWith :: ( MonadError e m
67 , HasNodeError e)
68 => Text -> m a
69 errorWith x = nodeError (NodeError x)
70
71 nodeError :: ( MonadError e m
72 , HasNodeError e)
73 => NodeError -> m a
74 nodeError ne = throwError $ _NodeError # ne
75
76 catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a
77 catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError))