#!/usr/bin/env stack
{- stack
     --nix
     --resolver lts-10.3
     --install-ghc
     runghc
     --package http-types
     --package yesod
     --package yesod-core
     --package text
     --package aeson
     --package acid-state
     --package cassava
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Acid
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Csv as Csv
import Data.SafeCopy
import Data.Semigroup
import qualified Data.Vector as Vector
import Data.Data (Data, Typeable)
import GHC.Generics
import Control.Monad
import Control.Monad.Reader (ask)
import Control.Monad.State (get, put)
import Data.Maybe (isJust)
import Data.Text hiding (take)
import Yesod hiding (Update, update, get)
import Network.HTTP.Types.Status (status400, status200)
import Data.Aeson

--------------------------------------------------------------------
-- | Here be the state and data model stuff.


-- | A type to describe the shape of our core model
data Caller = Caller
  { name :: Text
  , number :: Text
  , context :: Text
  }
  deriving (Show, Eq, Generic, ToJSON, FromJSON)

$(deriveSafeCopy 0 'base ''Caller)

-- | The database is just a list of @Caller@ records.
data Database = Database [Caller]

$(deriveSafeCopy 0 'base ''Database)

-- | Cons the caller to database.
addCaller :: Caller -> Update Database ()
addCaller caller = do
  Database callers <- get
  put $ Database (caller:callers)

-- | Grab a subset of the caller list.
viewCallers :: Int -> Query Database [Caller]
viewCallers limit = do
  Database callers <- ask
  return $ take limit callers

-- | This generates @AddCaller@ and @ViewCallers@ types automatically.
$(makeAcidic ''Database ['addCaller, 'viewCallers])

-----------------------------------------------------------------------
-- | Here be the HTTP stuff

data App = App
  { appState :: AcidState Database
  }

mkYesod "App" [parseRoutes|
/query QueryR GET
/number NumberR POST
|]

-- | Initiate Yesod. The default method instances are fine for a prototype or
-- demo app.
instance Yesod App

data ApiError = ApiError
  { msg :: Text
  }
  deriving (Show, Eq, Generic, ToJSON, FromJSON)

-- FIXME
findByNumber = id

getQueryR :: Handler RepJson
getQueryR = do
  qm <- lookupGetParam "number"
  case qm of
    Nothing -> do
      app <- getYesod
      let db = appState app
      callers <- liftIO $ query db (ViewCallers 20)
      sendStatusJSON status400 $ callers

    Just q -> do
      app <- getYesod
      let db = appState app
      sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ]


postNumberR :: Handler RepJson
postNumberR = do
  (obj :: Result Caller) <- parseJsonBody
  case obj of
    Error err ->
      sendStatusJSON status400 $ ApiError $ "Invalid request. Could not parse JSON body: " <> pack err

    Success caller -> do
      app <- getYesod
      let db = appState app
      liftIO $ update db $ AddCaller caller
      sendStatusJSON status200 $ caller


-- | Start a simple warp server on 3000
main :: IO ()
main = do
  seedData <- BSL.readFile "seed.csv"
  database <- openLocalStateFrom "database/" (Database [])
  case Csv.decode Csv.NoHeader seedData of
    Left err ->
      fail err

    Right v ->
      Vector.forM_ v $ \(number, context, name) -> do
        update database $ AddCaller $ Caller name number context
        putStrLn $ unpack $ name <> number <> context

  warp 3000 (App database)