module Hunt.CLI.Command.Client
  ( Command (..)
  , Error (..)
  , run
  , parser
  ) where


import           Control.Monad.Except
import           Data.Aeson
import           Data.Aeson.Encode.Pretty   (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Csv                   as CSV
import           Data.Either                (either)
import qualified Data.Map                   as M
import           Data.Monoid                ((<>))
import qualified Data.Text                  as T
import qualified Data.Text                  as T
import qualified Data.Vector                as V
import qualified Hunt.API                   as HC
import qualified Hunt.Client                as HC
import qualified Hunt.ClientInterface       as HC
import           Hunt.Common.ApiDocument    (LimitedResult)
import           Hunt.Interpreter
import qualified Hunt.Interpreter.Command   as I
import           Hunt.Query.Intermediate    (RankedDoc)
import qualified Hunt.Server                as Server
import           Network.HTTP.Client
import           Options.Applicative
import           Servant.Client             (BaseUrl, ClientM)
import qualified Servant.Client             as Servant



-- CLIENT COMMANDS


data Command
  = Eval Servant.BaseUrl FilePath
  | Search Servant.BaseUrl (Maybe HC.Offset) (Maybe HC.Limit) T.Text
  | Completion Servant.BaseUrl T.Text
  | MakeSchema FilePath
  | MakeInsert FilePath
  | FromCSV FilePath
  deriving (Show)



-- ERROR


data Error
  = JsonError String
  | HttpError Servant.ServantError
  deriving (Show)


formatError :: Error -> String
formatError (JsonError err) = "JSON parsing failed with err:\n" ++ err
formatError (HttpError err) =
  case err of
    Servant.FailureResponse (Servant.Response status body headers version) ->
      "Request failed with code " ++ show status ++ " and response body\n\n> " ++ show body

    Servant.DecodeFailure err (Servant.Response status body headers version) ->
      "Decoding response failed with error\n" ++ show err ++ "\n\non body\n\n>" ++
      show body

    Servant.ConnectionError err ->
      "Are you sure the Hunt server is running under the given URL? Here is the full error\n\n>" ++
      show err

    _ ->
      "Sorry, either the content type is not supported or invalid"




  PARSE FROM COMMAND LINE


parser :: Parser Command
parser = subparser
  (  cmd "eval"        eval       "Evaluate command in a given file on the Hunt server"
  <> cmd "search"      search     "Search the Hunt server for a given query"
  <> cmd "complete"    complete   "Retrieve completion proposals for a given query"
  <> cmd "make-schema" makeSchema "Print JSON schema for a document"
  <> cmd "make-insert" makeInsert "Print JSON command for insertion of document"
  <> cmd "from-csv"    fromCsv    "Convert CSV to JSON and print the result"
  )
  where
    cmd name parser desc =
      command name (info (helper <*> parser) (progDesc desc))

    eval :: Parser Command
    eval = Eval <$> serverOptions <*> file

    search :: Parser Command
    search = Search <$> serverOptions <*> offset <*> limit <*> query
      where
        query = T.pack <$> (argument str (metavar "QUERY"))

        offset = optional $
          option auto
          ( long "offset"
            <> help "Offset from which to start listing results" )

        limit = optional $
          option auto
          ( long "limit"
            <> help "Maximum number of results" )

    complete :: Parser Command
    complete = Completion <$> serverOptions <*> query
      where
        query = T.pack <$> (argument str (metavar "QUERY"))

    makeSchema :: Parser Command
    makeSchema = MakeSchema <$> file

    makeInsert :: Parser Command
    makeInsert = MakeInsert <$> file

    fromCsv :: Parser Command
    fromCsv = FromCSV <$> file



-- HELPER PARSERS


file :: Parser FilePath
file = argument str
  ( metavar "FILE"
   <> help "File to read command input from" )


serverOptions :: Parser Servant.BaseUrl
serverOptions =
  option parseUrl
  ( long "baseUrl"
  <> short 's'
  <> value defaultBaseUrl
  <> (help $ "Base URL of the Hunt server. Defaults to " ++ show defaultBaseUrl ))
  where
    parseUrl = eitherReader $
      either (Left . show) Right . Servant.parseBaseUrl

    defaultBaseUrl :: BaseUrl
    defaultBaseUrl = Servant.BaseUrl
      { Servant.baseUrlScheme = Servant.Http
      , Servant.baseUrlHost   = "localhost"
      , Servant.baseUrlPort   = 3000
      , Servant.baseUrlPath   = ""
      }



-- RUN


type Cmd
  = ExceptT Error IO


run :: Command -> IO ()
run command =
  case command of
    Eval opts file ->
      printCmd (putStrLn . show) $
        readAll file >>= decodeJson >>= request opts . HC.eval

    Search opts offset limit query ->
      printCmd printJson $
        (request opts (HC.searchText query offset limit) :: ExceptT Error IO (HC.LimitedResult RankedDoc))

    Completion opts query ->
      printCmd printJson $
        request opts $ HC.completeText query Nothing

    MakeSchema file ->
      printCmd printJson $
        readAll file >>= decodeApiDocs >>= pure . HC.createContextCommands

    MakeInsert file ->
      printCmd printJson $
        readAll file >>= decodeApiDocs >>= pure . HC.cmdSequence . fmap HC.cmdInsertDoc

    FromCSV file ->
      let
        eval input =
          undefined
      in
        error "This operation is not supported yet."



-- HELPERS


printCmd :: (a -> IO ()) -> Cmd a -> IO ()
printCmd f cmd = runExceptT cmd >>= either printErr f
  where printErr = putStrLn . formatError


printJson :: ToJSON a => a -> IO ()
printJson =
  LBS.putStrLn . encodePretty


readAll :: FilePath -> Cmd LBS.ByteString
readAll =
  lift . LBS.readFile


decodeJson :: FromJSON a => LBS.ByteString -> Cmd a
decodeJson =
  either (throwError . JsonError) return . eitherDecode


request :: Servant.BaseUrl -> ClientM a -> Cmd a
request baseUrl req = do
  client <- lift $ HC.withBaseUrl baseUrl
  result <- lift $ HC.runClientM req client
  either (throwError . HttpError) return result


decodeApiDocs :: LBS.ByteString -> Cmd [HC.ApiDocument]
decodeApiDocs json =
  HC.insertCmdsToDocuments <$> decodeJson json

 CLIENT COMMANDS
 ERROR
 HELPER PARSERS
 RUN
 HELPERS
module Hunt.CLI.Command.Client
  ( Command (..)
  , Error (..)
  , run
  , parser
  ) where


import           Control.Monad.Except
import           Data.Aeson
import           Data.Aeson.Encode.Pretty   (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Csv                   as CSV
import           Data.Either                (either)
import qualified Data.Map                   as M
import           Data.Monoid                ((<>))
import qualified Data.Text                  as T
import qualified Data.Text                  as T
import qualified Data.Vector                as V
import qualified Hunt.API                   as HC
import qualified Hunt.Client                as HC
import qualified Hunt.ClientInterface       as HC
import           Hunt.Common.ApiDocument    (LimitedResult)
import           Hunt.Interpreter
import qualified Hunt.Interpreter.Command   as I
import           Hunt.Query.Intermediate    (RankedDoc)
import qualified Hunt.Server                as Server
import           Network.HTTP.Client
import           Options.Applicative
import           Servant.Client             (BaseUrl, ClientM)
import qualified Servant.Client             as Servant





data Command
  = Eval Servant.BaseUrl FilePath
  | Search Servant.BaseUrl (Maybe HC.Offset) (Maybe HC.Limit) T.Text
  | Completion Servant.BaseUrl T.Text
  | MakeSchema FilePath
  | MakeInsert FilePath
  | FromCSV FilePath
  deriving (Show)





data Error
  = JsonError String
  | HttpError Servant.ServantError
  deriving (Show)


formatError :: Error -> String
formatError (JsonError err) = "JSON parsing failed with err:\n" ++ err
formatError (HttpError err) =
  case err of
    Servant.FailureResponse (Servant.Response status body headers version) ->
      "Request failed with code " ++ show status ++ " and response body\n\n> " ++ show body

    Servant.DecodeFailure err (Servant.Response status body headers version) ->
      "Decoding response failed with error\n" ++ show err ++ "\n\non body\n\n>" ++
      show body

    Servant.ConnectionError err ->
      "Are you sure the Hunt server is running under the given URL? Here is the full error\n\n>" ++
      show err

    _ ->
      "Sorry, either the content type is not supported or invalid"




  PARSE FROM COMMAND LINE


parser :: Parser Command
parser = subparser
  (  cmd "eval"        eval       "Evaluate command in a given file on the Hunt server"
  <> cmd "search"      search     "Search the Hunt server for a given query"
  <> cmd "complete"    complete   "Retrieve completion proposals for a given query"
  <> cmd "make-schema" makeSchema "Print JSON schema for a document"
  <> cmd "make-insert" makeInsert "Print JSON command for insertion of document"
  <> cmd "from-csv"    fromCsv    "Convert CSV to JSON and print the result"
  )
  where
    cmd name parser desc =
      command name (info (helper <*> parser) (progDesc desc))

    eval :: Parser Command
    eval = Eval <$> serverOptions <*> file

    search :: Parser Command
    search = Search <$> serverOptions <*> offset <*> limit <*> query
      where
        query = T.pack <$> (argument str (metavar "QUERY"))

        offset = optional $
          option auto
          ( long "offset"
            <> help "Offset from which to start listing results" )

        limit = optional $
          option auto
          ( long "limit"
            <> help "Maximum number of results" )

    complete :: Parser Command
    complete = Completion <$> serverOptions <*> query
      where
        query = T.pack <$> (argument str (metavar "QUERY"))

    makeSchema :: Parser Command
    makeSchema = MakeSchema <$> file

    makeInsert :: Parser Command
    makeInsert = MakeInsert <$> file

    fromCsv :: Parser Command
    fromCsv = FromCSV <$> file





file :: Parser FilePath
file = argument str
  ( metavar "FILE"
   <> help "File to read command input from" )


serverOptions :: Parser Servant.BaseUrl
serverOptions =
  option parseUrl
  ( long "baseUrl"
  <> short 's'
  <> value defaultBaseUrl
  <> (help $ "Base URL of the Hunt server. Defaults to " ++ show defaultBaseUrl ))
  where
    parseUrl = eitherReader $
      either (Left . show) Right . Servant.parseBaseUrl

    defaultBaseUrl :: BaseUrl
    defaultBaseUrl = Servant.BaseUrl
      { Servant.baseUrlScheme = Servant.Http
      , Servant.baseUrlHost   = "localhost"
      , Servant.baseUrlPort   = 3000
      , Servant.baseUrlPath   = ""
      }





type Cmd
  = ExceptT Error IO


run :: Command -> IO ()
run command =
  case command of
    Eval opts file ->
      printCmd (putStrLn . show) $
        readAll file >>= decodeJson >>= request opts . HC.eval

    Search opts offset limit query ->
      printCmd printJson $
        (request opts (HC.searchText query offset limit) :: ExceptT Error IO (HC.LimitedResult RankedDoc))

    Completion opts query ->
      printCmd printJson $
        request opts $ HC.completeText query Nothing

    MakeSchema file ->
      printCmd printJson $
        readAll file >>= decodeApiDocs >>= pure . HC.createContextCommands

    MakeInsert file ->
      printCmd printJson $
        readAll file >>= decodeApiDocs >>= pure . HC.cmdSequence . fmap HC.cmdInsertDoc

    FromCSV file ->
      let
        eval input =
          undefined
      in
        error "This operation is not supported yet."





printCmd :: (a -> IO ()) -> Cmd a -> IO ()
printCmd f cmd = runExceptT cmd >>= either printErr f
  where printErr = putStrLn . formatError


printJson :: ToJSON a => a -> IO ()
printJson =
  LBS.putStrLn . encodePretty


readAll :: FilePath -> Cmd LBS.ByteString
readAll =
  lift . LBS.readFile


decodeJson :: FromJSON a => LBS.ByteString -> Cmd a
decodeJson =
  either (throwError . JsonError) return . eitherDecode


request :: Servant.BaseUrl -> ClientM a -> Cmd a
request baseUrl req = do
  client <- lift $ HC.withBaseUrl baseUrl
  result <- lift $ HC.runClientM req client
  either (throwError . HttpError) return result


decodeApiDocs :: LBS.ByteString -> Cmd [HC.ApiDocument]
decodeApiDocs json =
  HC.insertCmdsToDocuments <$> decodeJson json
