module Main where

import Control.Monad.IO.Class
import Database.SQLite.Simple (Connection, open)
import Data.Monoid ((<>))
import Data.Text (pack)
import Network.HTTP.Types.Status (status404)
import Network.Wai.Middleware.Static (staticPolicy, hasPrefix)
import System.Environment (lookupEnv)
import Web.Spock
import Web.Spock.Config

import Render
import Types

respondWith :: MonadIO m => [Entry] -> ActionCtxT ctx m ()
respondWith es = do
  pref <- preferredFormat
  case pref of
    PrefJSON -> json es
    _        -> html (rPage (rEntries es))

db :: MonadIO m => DB a -> ActionCtxT Connection m a
db mote = do
  conn <- getContext
  liftIO (mote conn)

unwrap :: MonadIO m => Maybe a -> (a -> ActionCtxT ctx m ()) -> ActionCtxT ctx m ()
unwrap Nothing  _ = setStatus status404
unwrap (Just x) f = f x

main :: IO ()
main = do
  dbLoc <- maybe "test.db" id `fmap` lookupEnv "DB_LOC"
  port <- maybe 8080 read `fmap` lookupEnv "PORT"
  conn <- open dbLoc
  spockCfg <- defaultSpockCfg () PCNoDatabase ()
  runSpock port $ spock spockCfg $ prehook (return conn) $ do
    middleware $ staticPolicy (mempty <> hasPrefix "static")

    get root $ do
      html (rPage "welcome to the dictionary yo")

    get "add" $ do
      ls <- db allLanguages
      html (rPage (rAdd ls))

    get "search" $ do
      html (rPage rSearch)

    get ("lang") $ do
      ls <- db allLanguages
      html (rPage (rLangList ls))

    get ("lang" <//> var) $ \ lang -> do
      es <- db (getWordsByLanguage lang)
      respondWith es

    get "word" $ do
      es <- db getAllWords
      respondWith es
    post "word" $ do
      ps <- paramsToEntry <$> params
      unwrap ps $ \ e -> do
        i <- db (addWord e)
        redirect (pack ("/word/" ++ show i))

    get ("word" <//> var) $ \ w -> do
      eM <- db (getWordById w)
      unwrap eM $ \ e -> respondWith [e]
    post ("word" <//> var) $ \ w -> do
      ps <- paramsToEntry <$> params
      unwrap ps $ \ e -> do
          db (updateWord w e)
          redirect (pack ("/word/" ++ show w))

    get ("word" <//> var <//> "edit") $ \ w -> do
      eM <- db (getWordById w)
      ls <- db allLanguages
      unwrap eM $ html . rPage . rEdit w ls

    get ("word" <//> "search" <//> var) $ \ t -> do
      db (searchAll t) >>= respondWith

    get ("word" <//> "search" <//> "by-word" <//> var) $ \ t -> do
      db (searchWord t) >>= respondWith

    get ("word" <//> "search" <//> "by-meaning" <//> var) $ \ t -> do
      db (searchMeaning t) >>= respondWith