{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
module Client where

import           Control.Monad              (forM_)
import           Control.Monad.Except       (MonadError(..), ExceptT, runExceptT)
import           Control.Monad.Reader       (MonadReader(..), ReaderT, runReaderT, ask)
import           Control.Monad.IO.Class     (MonadIO, liftIO)
import           Data.Aeson                 (FromJSON(..), Value(..), (.:), (.:?), eitherDecode)
import           Data.ByteString            (ByteString)
import           Data.ByteString.Lazy       (toStrict)
import           Data.CaseInsensitive       (mk)
import           Data.Either                (either)
import           Data.Text                  (Text, pack)
import           Network.HTTP.Types
import           Network.Wai
import           Network.Wai.Test
import           System.Directory           (listDirectory, removeFile)
import           System.FilePath            ((</>))
import           Web.FormUrlEncoded

import           WebApp

data History = History [Weight] [TimeDistance] [SetRep] deriving Show
data Weight = Weight String String Float deriving Show
data TimeDistance = TimeDistance { tdUuid :: String
                                 , tdDate :: String
                                 , tdActivity :: String
                                 , tdDistance :: Maybe Float
                                 , tdDuration :: Maybe Int
                                 , tdComments :: Maybe String
                                 } deriving Show
data SetRep = SetRep deriving Show


data ClientExc = FailingStatus (Status, ByteString)
               | DecodeFailure String
               deriving Show

newtype ClientM a = ClientM (ReaderT (ByteString, Context) (ExceptT ClientExc IO) a)
    deriving (Functor, Applicative, Monad, MonadIO, MonadReader (ByteString, Context), MonadError ClientExc)

runClient :: (ByteString, Context) -> ClientM a -> IO (Either ClientExc a)
runClient ctx (ClientM act) = runExceptT $ runReaderT act ctx

instance FromJSON History where
    parseJSON (Object obj) = History <$> obj .: "weight"
                                     <*> obj .: "timeDistance"
                                     <*> obj .: "setRep"
    parseJSON v = error $ show v

instance FromJSON Weight where
    parseJSON (Object obj) = do
        (Object d) <- obj .: "data"
        Weight <$> obj .: "id"
               <*> d .: "date"
               <*> d .: "weight"
    parseJSON v = error $ show v

instance FromJSON TimeDistance where
    parseJSON (Object obj) = do
        (Object d) <- obj .: "data"
        TimeDistance <$> obj .: "id"
                     <*> d .: "date"
                     <*> d .: "activity"
                     <*> d .:? "distance"
                     <*> d .:? "duration"
                     <*> d .:? "comments"
    parseJSON v = error $ show v

instance FromJSON SetRep where
    parseJSON _ = pure SetRep


putWeight :: Maybe String -> String -> Float -> ClientM Weight
putWeight uuid date weight = do
    (authToken, ctx) <- ask
    let body = urlEncodeAsForm [ ("date" :: String, date)
                               , ("weight" :: String, show weight)
                               ]
    let (method, url) = case uuid of
            Nothing -> (methodPost, ["api", "weight"])
            Just uuid_ -> (methodPut, ["api", "weight", pack uuid_])
    let req = SRequest (defaultRequest { requestMethod = method
                                       , pathInfo = url
                                       , requestHeaders = [ (mk "Authorization", authToken)
                                                          , (mk "Content-Type", "application/x-www-form-urlencoded")
                                                          ]
                                       })
                       body
    resp <- liftIO $ runSession (srequest req) (webapp ctx)
    case statusCode $ simpleStatus resp of
        200 -> either (throwError . DecodeFailure) pure $ eitherDecode (simpleBody resp)
        _ -> throwError $ FailingStatus (simpleStatus resp, toStrict $ simpleBody resp)


putTimeDistance :: Maybe String -> String -> String -> Float -> Int -> String -> ClientM TimeDistance
putTimeDistance uuid date activity distance duration comments = do
    (authToken, ctx) <- ask
    let body = urlEncodeAsForm [ ("date" :: String, date)
                               , ("activity" :: String, activity)
                               , ("distance" :: String, show distance)
                               , ("duration" :: String, show duration)
                               , ("comments" :: String, comments)
                               ]
    let (method, url) = case uuid of
            Nothing -> (methodPost, ["api", "time-distance"])
            Just uuid_ -> (methodPut, ["api", "time-distance", pack uuid_])
    let req = SRequest (defaultRequest { requestMethod = method
                                       , pathInfo = url
                                       , requestHeaders = [ (mk "Authorization", authToken)
                                                          , (mk "Content-Type", "application/x-www-form-urlencoded")
                                                          ]
                                       })
                       body
    resp <- liftIO $ runSession (srequest req) (webapp ctx)
    case statusCode $ simpleStatus resp of
        200 -> either (throwError . DecodeFailure) pure $ eitherDecode (simpleBody resp)
        _ -> throwError $ FailingStatus (simpleStatus resp, toStrict $ simpleBody resp)


getHistory :: Maybe (Text, Text) -> ClientM History
getHistory interval = do
    (authToken, ctx) <- ask
    resp <- liftIO $ flip runSession (webapp ctx) $ case interval of
        Nothing -> 
            request defaultRequest { pathInfo = ["api", "history", "date"]
                                   , requestHeaders = [ (mk "Authorization", authToken) ]
                                   }
        Just (startTime, endTime) ->
            request defaultRequest { pathInfo = ["api", "history", "date", startTime, endTime]
                                   , requestHeaders = [ (mk "Authorization", authToken) ]
                                   }

    case statusCode $ simpleStatus resp of
        200 -> either (throwError . DecodeFailure) pure $ eitherDecode (simpleBody resp)
        _ -> throwError $ FailingStatus (simpleStatus resp, toStrict $ simpleBody resp)


removeSeries :: FilePath -> IO ()
removeSeries path = do
    files <- listDirectory path
    forM_ files $ \f -> removeFile (path </> f)


reloadSeries :: ClientM ()
reloadSeries = do
    (authToken, ctx) <- ask
    resp <- liftIO $ runSession (request defaultRequest { requestMethod = methodPut
                                                        , pathInfo = ["api", "reload"]
                                                        , requestHeaders = [ (mk "Authorization", authToken) ]
                                                        })
                                (webapp ctx)
    case statusCode $ simpleStatus resp of
        200 -> pure ()
        _ -> throwError $ FailingStatus (simpleStatus resp, toStrict $ simpleBody resp)

