#!/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
-}

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

import Data.Acid
import Data.SafeCopy
import Data.Semigroup
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, 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

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 ->
      sendStatusJSON status400 $ (ApiError "Invalid request. Could not parse 'number' parameter.")

    Just q ->
      sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ]


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

    Success v ->
      sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ]

-- | Start a simple warp server on 3000
main :: IO ()
main = warp 3000 App