dmjio
7/25/2016 - 6:00 PM

Test.hs

{-# LANGUAGE FlexibleInstances #-}                                                                                                                                                
{-# LANGUAGE TypeOperators #-}                                                                                                                                                    
{-# LANGUAGE DataKinds #-}                                                                                                                                                        
module Main where                                                                                                                                                                 
                                                                                                                                                                                  
import Servant                                                                                                                                                                    
import Servant.Server                                                                                                                                                             
import Lucid.Html5                                                                                                                                                                
import Lucid.Base                                                                                                                                                                 
import Servant.HTML.Lucid                                                                                                                                                         
import Network.Wai.Handler.Warp                                                                                                                                                   
                                                                                                                                                                                  
data Todo = Todo {                                                                                                                                                                
        todoId :: Int                                                                                                                                                             
      , todoBody :: String                                                                                                                                                        
      } deriving (Show)                                                                                                                                                           
                                                                                                                                                                                  
type API = "todos" :> Get '[HTML] [Todo]                                                                                                                                          
      :<|> "todo" :> Capture "int" Int :> Get '[HTML] Todo                                                                                                                        
                                                                                                                                                                                  
instance ToHtml [Todo] where                                                                                                                                                      
 toHtmlRaw = toHtml                                                                                                                                                               
 toHtml items = table_ $ do                                                                                                                                                       
     tr_ $ do                                                                                                                                                                     
       th_ "Item Id"                                                                                                                                                              
       th_ "Item Text"                                                                                                                                                            
                                                                                                                                                                                  
instance ToHtml Todo where                                                                                                                                                        
 toHtmlRaw = toHtml                                                                                                                                                               
 toHtml (Todo tid body) = do                                                                                                                                                      
     tr_ $ do                                                                                                                                                                     
       th_ "Item Id"                                                                                                                                                              
       th_ "Item Text"                                                                                                                                                            
                                                                                                                                                                                  
main :: IO ()                                                                                                                                                                     
main = run 8000 $ serve (Proxy :: Proxy API) app                                                                                                                                  
  where                                                                                                                                                                           
    app = todos :<|> getTodo                                                                                                                                                      
    todos = pure [ todo ]                                                                                                                                                         
    getTodo _ = pure todo                                                                                                                                                         
    todo = Todo 1 "eat milk"