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 module Gargantext.Database.Query.Table.Node.Error where
  12
  13 import Control.Lens (Prism', (#), (^?))
  14 import Control.Monad.Except (MonadError(..))
  15 import Data.Text (Text)
  16
  17 import Prelude hiding (null, id, map, sum)
  18
  19 import Gargantext.Database.Admin.Types.Node (NodeId)
  20 import Gargantext.Prelude hiding (sum, head)
  21
  22 ------------------------------------------------------------------------
  23 data NodeError = NoListFound
  24                | NoRootFound
  25                | NoCorpusFound
  26                | NoUserFound
  27                | MkNode
  28                | UserNoParent
  29                | HasParent
  30                | ManyParents
  31                | NegativeId
  32                | NotImplYet
  33                | ManyNodeUsers
  34                | DoesNotExist NodeId
  35                | NeedsConfiguration
  36                | NodeError Text
  37
  38 instance Show NodeError
  39   where
  40     show NoListFound   = "No list   found"
  41     show NoRootFound   = "No Root   found"
  42     show NoCorpusFound = "No Corpus found"
  43     show NoUserFound   = "No user   found"
  44
  45     show MkNode        = "Cannot make node"
  46     show NegativeId    = "Node with negative Id"
  47     show UserNoParent  = "Should not have parent"
  48     show HasParent     = "NodeType has parent"
  49     show NotImplYet    = "Not implemented yet"
  50     show ManyParents   = "Too many parents"
  51     show ManyNodeUsers = "Many userNode/user"
  52     show (DoesNotExist n)   = "Node does not exist (" <> show n <> ")"
  53     show NeedsConfiguration = "Needs configuration"
  54     show (NodeError e)      = "NodeError: " <> cs e
  55
  56 class HasNodeError e where
  57   _NodeError :: Prism' e NodeError
  58
  59 errorWith :: ( MonadError e m
  60             , HasNodeError e)
  61           => Text -> m a
  62 errorWith x = nodeError (NodeError x)
  63
  64 nodeError :: ( MonadError e m
  65              , HasNodeError e)
  66           => NodeError -> m a
  67 nodeError ne = throwError $ _NodeError # ne
  68
  69 catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a
  70 catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError))