src/Data/Gargantext/Server.hs

   1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
   2 {-# LANGUAGE DataKinds       #-}
   3 {-# LANGUAGE TemplateHaskell #-}
   4 {-# LANGUAGE TypeOperators   #-}
   5 module Data.Gargantext.Server
   6 --    ( startApp
   7 --    , app
   8 --    )
   9       where
  10
  11 import Control.Monad
  12 import Control.Monad.IO.Class
  13 import Data.Aeson
  14 import Data.Aeson.TH
  15 import Network.Wai
  16 import Network.Wai.Handler.Warp
  17 import Servant
  18 import Servant.Multipart
  19
  20 -- | TODO, use MOCK feature of Servant to generate fake data (for tests)
  21
  22 data FakeNode = FakeNode
  23   { fakeNodeId        :: Int
  24   , fakeNodeName      :: String
  25   } deriving (Eq, Show)
  26
  27 $(deriveJSON defaultOptions ''FakeNode)
  28
  29 type API = "nodes"   :> Get '[JSON] [FakeNode]
  30        :<|> "node"   :> Capture "id" Int            :> Get '[JSON] FakeNode
  31        :<|> "echo"   :> Capture "string" String     :> Get '[JSON] String
  32        :<|> "upload" :> MultipartForm MultipartData :> Post '[JSON] String
  33
  34        -- :<|> "node"  :> Capture "id" Int        :> Get '[JSON] Node
  35
  36 server :: Server API
  37 server = pure fakeNodes
  38         :<|> fakeNode
  39         :<|> echo
  40         :<|> upload
  41     where
  42         echo s = pure s
  43
  44
  45 startGargantext :: IO ()
  46 startGargantext = print ("Starting server on port " ++ show port)  >> run port app
  47     where
  48         port = 8008
  49
  50 -- | TODO App type, the main monad in which the bot code is written with.
  51 -- Provide config, state, logs and IO
  52 -- type App m a =  ( MonadState AppState m
  53 --                 , MonadReader Conf m
  54 --                 , MonadLog (WithSeverity Doc) m
  55 --                 , MonadIO m) => m a
  56 -- Thanks @yannEsposito for this.
  57 app :: Application
  58 app = serve api server
  59
  60 api :: Proxy API
  61 api = Proxy
  62
  63
  64 fakeNode :: Monad m => Int -> m FakeNode
  65 fakeNode id = pure (fakeNodes !! id)
  66
  67 fakeNodes :: [FakeNode]
  68 fakeNodes = [ FakeNode 1 "Poincare"
  69             , FakeNode 2 "Grothendieck"
  70             ]
  71
  72 -- | Upload files
  73 -- TODO Is it possible to adapt the function according to iValue input ?
  74 upload :: MultipartData -> Handler String
  75 upload multipartData = do
  76   liftIO $ do
  77     putStrLn "Inputs:"
  78     forM_ (inputs multipartData) $ \input ->
  79       putStrLn $ "  " ++ show (iName input)
  80             ++ " -> " ++ show (iValue input)
  81
  82     forM_ (files multipartData) $ \file -> do
  83       content <- readFile (fdFilePath file)
  84       putStrLn $ "Content of " ++ show (fdFileName file)
  85               ++ " at " ++ fdFilePath file
  86       putStrLn content
  87   pure "Data loaded"