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