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