content: {-# LANGUAGE QuasiQuotes, RecordWildCards, OverloadedStrings #-}
  
  module Language.MessagePack.IDL.CodeGen.Ruby (
    Config(..),
    generate,
    ) where
  
  import Data.Char
  import Data.List
  import Data.Monoid
  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 System.Directory
  
  import Language.MessagePack.IDL.Syntax
  
  data Config
    = Config
      { configFilePath :: FilePath
      , configModule :: String
      }
    deriving (Show, Eq)
  
  generate:: Config -> Spec -> IO ()
  generate Config {..} spec = do
    createDirectoryIfMissing True (takeBaseName configFilePath);
    setCurrentDirectory (takeBaseName configFilePath);
    let
          mods = LT.splitOn "::" $ LT.pack configModule
          
    LT.writeFile "types.rb" $ templ configFilePath [lt|
  require 'rubygems'
  require 'msgpack/rpc'
  #{genModule mods $ LT.concat $ map (genTypeDecl "") spec }
  |]
    
    LT.writeFile ("client.rb") $ templ configFilePath [lt|
  require 'rubygems'
  require 'msgpack/rpc'
  require File.join(File.dirname(__FILE__), 'types')
  
  #{genModule (snoc mods "Client") $ LT.concat $ map genClient spec}|]
  
  genTypeDecl :: String -> Decl -> LT.Text
  genTypeDecl _ MPType {..} = [lt|
  class #{capitalizeT tyName}
    def #{capitalizeT tyName}.from_tuple(tuple)
      #{fromTuple tyType "tuple"}
    end
    def to_tuple(o)
      o
    end
  end
  |]
  
  genTypeDecl _ MPMessage {..} =
    genMsg msgName msgFields False
  
  genTypeDecl _ MPException {..} =
    genMsg excName excFields True
    
  genTypeDecl _ _ = ""
  
  genMsg :: T.Text -> [Field] -> Bool -> LT.Text
  genMsg name flds isExc = [lt|
  class #{capitalizeT name}#{deriveError}
    def initialize(#{T.intercalate ", " fs})
      #{LT.intercalate "\n    " $ map makeSubst fs}
    end
    def to_tuple    
      [#{LT.intercalate ",\n     " $ map make_tuple flds}]
    end
    def to_msgpack(out = '')
      to_tuple.to_msgpack(out)
    end
    def #{capitalizeT name}.from_tuple(tuple)
      #{capitalizeT name}.new(
        #{LT.intercalate ",\n      " $ map make_arg flds}
      )
    end
  #{indent 2 $ genAccessors sorted_flds}
  end
  |]-- #{indent 2 $ LT.concat writers}
    where
      sorted_flds = sortField flds
      fs = map (maybe undefined fldName) sorted_flds
  --    afs = LT.intercalate ",\n     " $ map make_tuple flds
      make_tuple Field {..} = 
        [lt|#{toTuple True fldType fldName}|]
      deriveError = if isExc then [lt| < StandardError|] else ""
      make_arg Field {..} =
        let fldIdstr = T.concat $ map T.pack ["tuple[", (show fldId), "]"]
        in [lt|#{fromTuple fldType fldIdstr}|]
  
  makeSubst :: T.Text -> LT.Text
  makeSubst fld = [lt| @#{fld} = #{fld} |]
  
  toTuple :: Bool -> Type -> T.Text -> LT.Text
  toTuple _ (TTuple ts) name = 
    let elems = map (f name) (zip [0..] ts) in
    [lt| [#{LT.concat elems}] |]
      where
        f :: T.Text -> (Integer, Type) -> LT.Text
        f n (i, (TUserDef _fg _ )) = [lt|#{n}[#{show i}].to_tuple}, |]
        f n (i, _) = [lt|#{n}[#{show i}], |]
  
  toTuple True t name = [lt|@#{toTuple False t name}|]
  toTuple _ (TNullable t) name = [lt|#{toTuple False t name}|]
  toTuple _ (TInt _ _)    name = [lt|#{name}|]
  toTuple _ (TFloat _)    name = [lt|#{name}|]
  toTuple _ TBool         name = [lt|#{name}|]
  toTuple _ TRaw          name = [lt|#{name}|]
  toTuple _ TString       name = [lt|#{name}|]
  toTuple _ (TList typ)   name = [lt|#{name}.map {|x| #{toTuple False typ "x"}}|]
  toTuple _ (TMap typ1 typ2) name =
    [lt|#{name}.each_with_object({}) {|(k,v),h| h[#{toTuple False typ1 "k"}] = #{toTuple False typ2 "v"}}|]
  toTuple _ (TUserDef _ _) name = [lt|#{name}.to_tuple|]
  
  toTuple _ _ _ = ""
  
  fromTuple :: Type -> T.Text -> LT.Text
  fromTuple (TNullable t) name = [lt|#{fromTuple t name}|]
  fromTuple (TInt _ _) name    = [lt|#{name}|]
  fromTuple (TFloat _) name    = [lt|#{name}|]
  fromTuple TBool name         = [lt|#{name}|]
  fromTuple TRaw name          = [lt|#{name}|]
  fromTuple TString name       = [lt|#{name}|]
  fromTuple (TList typ) name =
    [lt|#{name}.map { |x| #{fromTuple typ "x"} }|]
    
  fromTuple (TMap typ1 typ2) name =
    [lt|#{name}.each_with_object({}) {|(k,v),h| h[#{fromTuple typ1 "k"}] = #{fromTuple typ2 "v"} }|]
  
  fromTuple (TUserDef className _) name = [lt|#{capitalizeT className}.from_tuple(#{name})|]
  
  fromTuple (TTuple ts) name =
    let elems = map (f name) (zip [0..] ts) in
    [lt| [#{LT.intercalate ", " elems}] |]
      where
        f :: T.Text -> (Integer, Type) -> LT.Text
        f n (i, (TUserDef className _ )) = [lt|#{capitalizeT className}.from_tuple(#{n}[#{show i}]) |]
        f n (i, _) = [lt|#{n}[#{show i}] |]
  
  fromTuple (TObject) name = [lt|#{name}|]
  
  capitalizeT :: T.Text -> T.Text
  capitalizeT a = T.cons (toUpper $ T.head a) (T.tail a)
  
  sortField :: [Field] -> [Maybe Field]
  sortField flds =
    flip map [0 .. maximum $ [-1] ++ map fldId flds] $ \ix -> find ((==ix). fldId) flds
  
  indent :: Int -> LT.Text -> LT.Text
  indent ind lines = indentedConcat ind $ LT.lines lines
  
  indentedConcat :: Int -> [LT.Text] -> LT.Text
  indentedConcat ind lines =
    LT.dropAround (== '\n') $ LT.unlines $ map (indentLine ind) lines
  
  indentLine :: Int -> LT.Text -> LT.Text
  indentLine _ "" = ""
  indentLine ind line = mappend (LT.pack $ replicate ind ' ') line
  
  {-
  extractJust :: [Maybe a] -> [a]
  extractJust [] = []
  extractJust (Nothing:xs) = extractJust xs
  extractJust (Just v:xs)  = v : extractJust xs
  -}
  
  data AccessorType = Read | ReadWrite deriving Eq
  
  getAccessorType :: Type -> AccessorType
  getAccessorType TBool = Read
  getAccessorType (TMap _ _) = Read
  getAccessorType (TUserDef _ _) = Read
  getAccessorType _ = ReadWrite
  
  genAccessors :: [Maybe Field] -> LT.Text
  genAccessors [] = ""
  genAccessors fs = [lt|
  #{genAccessors' Read "attr_reader" fs}#{genAccessors' ReadWrite "attr_accessor" fs}|]
  
  genAccessors' :: AccessorType -> String -> [Maybe Field] -> LT.Text
  genAccessors' at an flds = gen $ map (maybe undefined fldName) $ filter fldTypeEq flds
    where
      gen [] = ""
      gen fs = [lt|
  #{an} #{T.intercalate ", " $ map (mappend ":") fs}|]
  
      fldTypeEq (Just Field {..}) = at == getAccessorType fldType
      fldTypeEq Nothing           = False
  
  
  -- TODO: Check when val is not null with TNullable
  -- TODO: Write single precision value on TFloat False
  {-
  genAttrWriter :: Field -> LT.Text
  genAttrWriter Field {..} = genAttrWriter' fldType fldName
  
  genAttrWriter' :: Type -> T.Text -> LT.Text
  
  genAttrWriter' TBool n = [lt|
  def #{n}=(val)
    @#{n} = val.to_b
  end
  |]
  
  genAttrWriter' (TMap kt vt) n = [lt|
  def #{n}=(val)
    @#{n} = {}
    val.each do |k, v|
  #{indent 4 $ convert "k" "newk" kt}
  #{indent 4 $ convert "v" "newv" vt}
    end
  end
  |]
    where
      convert from to (TUserDef t p) =
          genConvertingType from to (TUserDef t p)
      convert from to _ = [lt|#{to} = #{from}|]
  genAttrWriter' (TUserDef name types) n = [lt|
  def #{n}=(val)
  #{indent 2 $ convert "val" atn (TUserDef name types)}
  end
  |]
    where
      atn = [lt|@#{n}|]
      convert from to (TUserDef t p) =
          genConvertingType from to (TUserDef t p)
  genAttrWriter' _ _ = ""
  -}
  
  
  genClient :: Decl -> LT.Text
  genClient MPService {..} = [lt|
  class #{capitalizeT serviceName}
    def initialize(host, port)
      @cli = MessagePack::RPC::Client.new(host, port)
    end#{LT.concat $ map genMethodCall serviceMethods}
  end
  |]
    where
      genMethodCall Function {..} = [lt|
    def #{methodName}(#{defArgs})
  #{indent 4 $ genConvertingType' callStr "v" methodRetType}
    end|]
        where
          defArgs = T.intercalate ", " $ map fldName methodArgs
          callStr = [lt|@cli.call(#{callArgs})|]
          callArgs = mappend ":" $ T.intercalate ", " $ methodName : sortedArgNames
          sortedArgNames = map (maybe undefined fldName) $ sortField methodArgs
  
  genClient _ = ""
  
  genConvertingType :: LT.Text -> LT.Text -> Type -> LT.Text
  genConvertingType unpacked _ (TUserDef t _) = [lt|
  #{capitalizeT t}.from_tuple(#{unpacked})|]
  genConvertingType _ _ _ = ""
  
  genConvertingType' :: LT.Text -> LT.Text -> Maybe Type -> LT.Text
  genConvertingType' unpacked v (Just (TUserDef t p)) = [lt|
  #{genConvertingType unpacked v (TUserDef t p)}
  |]
  genConvertingType' unpacked _ _ = [lt|#{unpacked}|]
  
  templ :: FilePath -> LT.Text -> LT.Text
  templ filepath content = [lt|# This file is auto-generated from #{filepath}
  # *** DO NOT EDIT ***
  #{content}
  |]
  
  genModule :: [LT.Text] -> LT.Text -> LT.Text
  genModule modules content = f modules
    where
      f [] = [lt|#{content}|]
      f (n:ns) = [lt|module #{n}
  #{f ns}
  end|]
  
  snoc :: [a] -> a -> [a]
  snoc xs x = xs ++ [x]
  