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