{-# LANGUAGE QuasiQuotes, RecordWildCards, OverloadedStrings #-}

module Language.MessagePack.IDL.CodeGen.Php (
  Config(..),
  generate,
  ) where

import Data.Char
import Data.List
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.IO as LT
import System.FilePath
import Text.Shakespeare.Text
import Data.Monoid

import Language.MessagePack.IDL.Syntax

data Config
  = Config
    { configFilePath :: FilePath
    }
  deriving (Show, Eq)

generate:: Config -> Spec -> IO ()
generate Config {..} spec = do
  let name = takeBaseName configFilePath
      once = map toUpper name
      
  LT.writeFile (name ++ "_types.php") $ templ configFilePath once "TYPES" [lt|
include_once 'Net/MessagePackRPC.php';

#{LT.concat $ map genTypeDecl spec}

class ObjectDecoder {
  public static $USER_DEFINED_CLASSES = array(
    #{LT.concat $ map genClassName spec}
  );
  public static function decodeToObject($ret_array, $type_array) {
    if ($type_array == "") {
      // do nothing
      $ret = $ret_array;
    } else if (in_array($type_array, self::$USER_DEFINED_CLASSES)) {
      // array -> object
      $ret = new $type_array();
      $ret_keys = array_keys((array)$ret);
      for ($i = 0; $i < count($ret_keys); $i++) {
        $ret->{$ret_keys[$i]} = $ret_array[$i];
      }
    } else {
      // dissolve array
      if (is_array($type_array)) {
        if (count($type_array) == 1) {
          // if array
          foreach ($type_array as $key => $type) {
            foreach ($ret_array as $ret_key => $ret_value) {
              $ret[$ret_key] = $this->decodeToObject($ret_value, $type);
            }
          }
        } else {
          // if tuple
          $ret = array();
          $i = 0;
          foreach ($type_array as $type) {
            $ret[$i] = $this->decodeToObject($ret_array[$i], $type);
            $i++;
          }
        }
      } else {
        // type error
        return $ret_array;
      }
    }
    return $ret;
  }
}
 
|]

  LT.writeFile (name ++ "_client.php") [lt|
<?php
include_once(dirname(__FILE__)."/#{name}_types.php");

#{LT.concat $ map genClient spec}
?>
|]

genClassName :: Decl -> LT.Text
genClassName MPMessage {..} =
  [lt|  "#{msgName}",
  |]  
genClassName _ = ""

genTypeDecl :: Decl -> LT.Text
genTypeDecl MPMessage {..} =
  genMsg msgName msgFields False

genTypeDecl MPException {..} =
  genMsg excName excFields True

genTypeDecl _ = ""

genMsg name flds isExc =
  let fields = map f flds
      fs = map (maybe undefined fldName) $ sortField flds
  in [lt|
class #{name}#{e} {

#{LT.concat fields}
}
|]
  where
    e = if isExc then [lt| extends Exception|] else ""

    f Field {..} = [lt| public $#{fldName};
|]

sortField flds =
  flip map [0 .. maximum $ [-1] ++ map fldId flds] $ \ix ->
  find ((==ix). fldId) flds

genClient :: Decl -> LT.Text
genClient MPService {..} = [lt|
class #{serviceName} {
  public function __construct($host, $port) {
    $this->client = new MessagePackRPC_Client($host, $port);
  }
#{LT.concat $ map genMethodCall serviceMethods}
  private $client;
}
|]
  where
  genMethodCall Function {..} =
    let args = LT.intercalate ", " $ map arg methodArgs in
    let sortedArgs = LT.intercalate ", " $ map (maybe undefined arg) $ sortField methodArgs in
    case methodRetType of
      TVoid -> [lt|
  public function #{methodName}(#{args}) {
    $this->client->call("#{methodName}", array(#{sortedArgs}));
  }
|]
      _ -> [lt|
  public function #{methodName}(#{args}) {
    $ret = $this->client->call("#{methodName}", array(#{sortedArgs}));
    $type_array = #{genTypeArray methodRetType};
    return ObjectDecoder::decodeToObject($ret, $type_array);
  }
|]
    where
      arg Field {..} = [lt|$#{fldName}|]

  genMethodCall _ = ""
  
genClient _ = ""

genTypeArray :: Type -> LT.Text
genTypeArray (TList typ) =
  [lt|array(#{genTypeArray typ})|]
genTypeArray (TMap typ1 typ2) =
  [lt|array(#{genTypeArray typ1} => #{genTypeArray typ2})|]
genTypeArray (TUserDef className params) =
  [lt|"#{className}"|]
genTypeArray (TTuple ts) =
  foldr1 (\t1 t2 -> [lt|array(#{t1}, #{t2})|]) $ map genTypeArray ts
genTypeArray _ = [lt|""|]

genType :: Type -> LT.Text
genType (TUserDef className params) =
  [lt|#{className}|]
genType _ = ""

templ :: FilePath -> String -> String -> LT.Text -> LT.Text
templ filepath once name content = [lt|
// This file is auto-generated from #{filepath}
// *** DO NOT EDIT ***
<?php
#{content}
?>
|]
    
snoc xs x = xs ++ [x]