How to lift to Servant Server type?

Question

I am having problems with following code:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module API where

import           Data.Text
import           Servant.API
import           Servant
import           Repository 
import           FileOperation
import           Util
import           Config
import qualified Data.Map                   as M
import           Control.Monad.State.Strict (liftIO)
import           Network.Wai.Handler.Warp

type RepositoryAPI = "repository" :> "all" :> Get '[JSON] [Repository] 
                :<|> "all" :> "repository" :> Get '[JSON] [Repository]

server :: Server RepositoryAPI
server = do
  repositoriesMap <- liftIO $ loadFromFile repositoryMapFile
  let repositories = M.elems repositoriesMap in do
    return repositories 

repositoryAPI :: Proxy RepositoryAPI 
repositoryAPI = Proxy

app :: Application
app = serve repositoryAPI server

main :: IO ()
main = run 8081 app

The error I get is:

API.hs:22:3: error:
    • Couldn't match type ‘[a0]’ with ‘Handler [Repository]’
      Expected type: Server RepositoryAPI
        Actual type: Handler [Repository] :<|> [a0]
    • In a stmt of a 'do' block:
        repositoriesMap <- liftIO $ loadFromFile repositoryMapFile
      In the expression:
        do repositoriesMap <- liftIO $ loadFromFile repositoryMapFile
           let repositories = ... in do return repositories
      In an equation for ‘server’:
          server
            = do repositoriesMap <- liftIO $ loadFromFile repositoryMapFile
                 let ... in do ...
   |
22 |   repositoriesMap <- liftIO $ loadFromFile repositoryMapFile
   |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

The question is how do I lift properly so that the lift returns Servant Server type?

Answer 1

The problem has nothing to do with lifting. The real problem is that you only specified one Handler, but your server needs two Handlers, one for "repository" :> "all" :> Get '[JSON] [Repository] and one for "all" :> "repository" :> Get '[JSON] [Repository]. Here's a skeleton for your second one (replace your existing server with this):

getRepositoryAll :: Handler [Repository]
getRepositoryAll = do
  repositoriesMap <- liftIO $ loadFromFile repositoryMapFile
  let repositories = M.elems repositoriesMap in do
    return repositories 

getAllRepository :: Handler [Repository]
getAllRepository = undefined -- fill this in

server :: Server RepositoryAPI
server = getRepositoryAll :<|> getAllRepository