{-# LANGUAGE OverloadedStrings #-}
module TW.CodeGen.Flow
    ( makeFileName, makeModule
    )
where

import TW.Ast
import TW.BuiltIn
import TW.JsonRepr

import Data.Monoid
import System.FilePath
import qualified Data.List as L
import qualified Data.Text as T

makeFileName :: ModuleName -> FilePath
makeFileName (ModuleName parts) =
    (L.foldl' (</>) "" $ map T.unpack parts) ++ ".js"

makeModule :: Module -> T.Text
makeModule m =
    T.unlines
    [ "/* @flow */"
    , "// This file was auto generated by typed-wire. Do not modify by hand"
    , "// Module Name: " <> printModuleName (m_name m) <> ""
    , ""
    , T.intercalate "\n" (map makeImport $ m_imports m)
    , ""
    , T.intercalate "\n" (map makeTypeDef $ m_typeDefs m)
    , ""
    ]

makeImport :: ModuleName -> T.Text
makeImport m =
    "import " <> printModuleName m <> ";"

makeTypeDef :: TypeDef -> T.Text
makeTypeDef td =
    case td of
      TypeDefEnum ed ->
          makeEnumDef ed
      TypeDefStruct sd ->
          makeStructDef sd

makeStructDef :: StructDef -> T.Text
makeStructDef sd =
    T.unlines
    [ "export type " <> makeTypeName (sd_name sd) (sd_args sd) <> " ="
    , "   {| " <> T.intercalate "\n   , " (map makeStructField $ sd_fields sd)
    , "   |}"
    , ""
    ]

makeStructField :: StructField -> T.Text
makeStructField sf =
    (unFieldName $ sf_name sf) <> " : " <> (makeType $ sf_type sf)

makeEnumDef :: EnumDef -> T.Text
makeEnumDef ed =
    T.unlines
    [ "export type " <> makeTypeName (ed_name ed) (ed_args ed)
    , "   = " <> T.intercalate "\n   | " (map makeEnumChoice $ ed_choices ed)
    , ""
    ]

makeEnumChoice :: EnumChoice -> T.Text
makeEnumChoice ec =
        let constr = unChoiceName $ ec_name ec
            tag = camelTo2 '_' $ T.unpack constr
            fieldVal =
                case ec_arg ec of
                  Nothing -> "true"
                  Just arg -> makeType arg
        in "{|" <> T.pack tag <>  ": " <> fieldVal <> "|}"

makeTypeName :: TypeName -> [TypeVar] -> T.Text
makeTypeName tname targs =
  let types = T.intercalate ", " (map unTypeVar targs)
  in unTypeName tname <> (if null targs then types else ("<" <> types <> ">"))

makeType :: Type -> T.Text
makeType t =
    case isBuiltIn t of
      Nothing ->
          case t of
            TyVar (TypeVar x) -> x
            TyCon qt args ->
                let ty = makeQualTypeName qt
                in case args of
                     [] -> ty
                     _ -> ty <> "<" <> T.intercalate ", " (map makeType args) <> ">"
      Just (bi, tvars)
          | bi == tyString -> "string"
          | bi == tyInt -> "number"
          | bi == tyBool -> "boolean"
          | bi == tyFloat -> "number"
          | bi == tyDateTime -> "Date"
          | bi == tyTime -> "Date"
          | bi == tyDate -> "Date"
          | bi == tyMaybe -> "(? " <> T.intercalate " " (map makeType tvars) <> ")"
          | bi == tyList -> "Array<" <> T.intercalate " " (map makeType tvars) <> ">"
          | bi == tyBytes -> "UInt8Array" -- TODO: CHECK
          | otherwise ->
              error $ "Flow: Unimplemented built in type: " ++ show t

makeQualTypeName :: QualTypeName -> T.Text
makeQualTypeName qtn =
    case unModuleName $ qtn_module qtn of
      [] -> ty
      _ -> printModuleName (qtn_module qtn) <> "." <> ty
    where
      ty = unTypeName $ qtn_type qtn
