[CLEAN] readFile homonyms
[gargantext.git] / src / Gargantext / API / Types.hs
index 00583d389d5193d4d7095f462a6926b4a4527a93..7ab9e06662b3f3425c2d4a3b9ff31be8300550fd 100644 (file)
-{-|
-Module      : Gargantext.API.Types
-Description : Server API main Types
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
+{-# OPTIONS_GHC -fprint-potential-instances #-}
 
--}
+module Gargantext.API.Types where
 
-
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE RankNTypes             #-}
-{-# LANGUAGE TemplateHaskell        #-}
-{-# LANGUAGE TypeOperators          #-}
-{-# LANGUAGE UndecidableInstances   #-}
-
-module Gargantext.API.Types
-  ( module Gargantext.API.Types
-  , HasServerError(..)
-  , serverError
-  )
-  where
-
-import Control.Exception (Exception)
-import Control.Lens (Prism', (#))
-import Control.Lens.TH (makePrisms)
-import Control.Monad.Error.Class (MonadError(throwError))
-import Crypto.JOSE.Error as Jose
-import Data.Aeson.Types
+import Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as BS8
+import Data.Either (Either(..))
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Text (Text)
+import qualified Data.Text.Encoding as E
 import Data.Typeable
-import Data.Validity
+import Network.HTTP.Media ((//), (/:))
+import Prelude (($))
+import qualified Prelude
 import Servant
-import Servant.Job.Core (HasServerError(..), serverError)
-import Servant.Job.Async (HasJobEnv)
-import Gargantext.Prelude
-import Gargantext.API.Settings
-import Gargantext.API.Orchestrator.Types
-import Gargantext.API.Ngrams
-import Gargantext.Core.Types
-import Gargantext.Database.Tree
-import Gargantext.Database.Utils
-import Gargantext.Database.Schema.Node
-
-class HasJoseError e where
-  _JoseError :: Prism' e Jose.Error
-
-joseError :: (MonadError e m, HasJoseError e) => Jose.Error -> m a
-joseError = throwError . (_JoseError #)
-
-class ThrowAll' e a | a -> e where
-  -- | 'throwAll' is a convenience function to throw errors across an entire
-  -- sub-API
-  --
-  --
-  -- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c
-  -- >    == throwError err400 :<|> throwError err400 :<|> err400
-  throwAll' :: e -> a
-
-instance (ThrowAll' e a, ThrowAll' e b) => ThrowAll' e (a :<|> b) where
-  throwAll' e = throwAll' e :<|> throwAll' e
-
--- Really this shouldn't be necessary - ((->) a) should be an instance of
--- MonadError, no?
-instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where
-  throwAll' e = const $ throwAll' e
-
-instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
-  throwAll' = throwError
-
-type GargServerC env err m =
-    ( CmdM         env err m
-    , HasNodeError     err
-    , HasInvalidError  err
-    , HasTreeError     err
-    , HasServerError   err
-    , HasJoseError     err
-    , ToJSON           err -- TODO this is arguable
-    , Exception        err
-    , HasRepo      env
-    , HasSettings  env
-    , HasJobEnv    env ScraperStatus ScraperStatus
-    )
-
-type GargServerT env err m api = GargServerC env err m => ServerT api m
-
-type GargServer api =
-  forall env err m. GargServerT env err m api
-
--------------------------------------------------------------------
--- | This Type is needed to prepare the function before the GargServer
-type GargNoServer' env err m =
-  ( CmdM           env err m
-  , HasRepo        env
-  , HasSettings    env
-  , HasNodeError       err
-  )
-
-type GargNoServer t =
-  forall env err m. GargNoServer' env err m => m t
--------------------------------------------------------------------
-
-data GargError
-  = GargNodeError    NodeError
-  | GargTreeError    TreeError
-  | GargInvalidError Validation
-  | GargJoseError    Jose.Error
-  | GargServerError  ServerError
-  deriving (Show, Typeable)
-
-makePrisms ''GargError
-
-instance ToJSON GargError where
-  toJSON _ = String "SomeGargErrorPleaseReport"
-
-instance Exception GargError
-
-instance HasNodeError GargError where
-  _NodeError = _GargNodeError
-
-instance HasInvalidError GargError where
-  _InvalidError = _GargInvalidError
-
-instance HasTreeError GargError where
-  _TreeError = _GargTreeError
-
-instance HasServerError GargError where
-  _ServerError = _GargServerError
-
-instance HasJoseError GargError where
-  _JoseError = _GargJoseError
+  ( Accept(..)
+  , MimeRender(..)
+  , MimeUnrender(..) )
+
+data HTML deriving (Typeable)
+instance Accept HTML where
+  contentTypes _ = "text" // "html" /: ("charset", "utf-8") :| ["text" // "html"]
+instance MimeRender HTML BS8.ByteString where
+  mimeRender _ = Prelude.id
+instance MimeUnrender HTML BS8.ByteString where
+    mimeUnrender _ bs = Right bs
+instance MimeRender HTML Text where
+    mimeRender _ bs = BS8.fromStrict $ E.encodeUtf8 bs
+instance MimeUnrender HTML Text where
+    mimeUnrender _ bs = Right $ E.decodeUtf8 $ BS8.toStrict bs
+instance {-# OVERLAPPABLE #-} ToJSON a => MimeRender HTML a where
+  mimeRender _ = encode