JoiFromTypeScript - Converts TypeScript interface and type statements to Joi schema generators.

JoiFromTypeScript.hs

#!/usr/bin/env runhaskell

{-|
Module      : JoiFromTypeScript
Description : Converts TypeScript interface and type statements to Joi schema generators.
Copyright   : monnef
Maintainer  : monnef2@gmail.com
Stability   : experimental

= Dependencies
* Parsec
* Hclip

= Usage
* Copy your @interface@ or @type@ statement to your clipboard.
* Run this program.
* If everything went well you have now Joi scheme creator (function) in your clipboard ready to be pasted.

= Example
Input (from the clipboard):
@
export interface SomeInterface {
  arrayOfStrings:string[];
  optionalNumber?:number;
  cClass:C;
}
@
Output (in the clipboard after running this program):
@
export const createSomeInterfaceSchema = () => Joi.object({
  arrayOfStrings: Joi.array().items(Joi.string()).required(),
  optionalNumber: Joi.number(),
  cClass: createCSchema().required()
});
@

= Known limitations
* Only selected type are supported (namely string, number, boolean, special form of array and class reference)
* Only one dimensional arrays denoted by @[]@ are supported (e.g. @Car[]@ is fine).
* Generics or other more advanced type constructs are __not__ supported (but basic inheritance is fine).
-}

module JoiFromTypeScript where

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}

import           Control.Applicative           ((<|>))
import           Control.Lens.Operators
import           Data.Char
import           Data.List
import           Data.Maybe
import           System.Hclip
import           Text.Parsec.Char
import           Text.ParserCombinators.Parsec hiding (spaces, (<|>))

data RhsType = TypeString
             | TypeNumber
             | TypeBoolean
             | TypeEnum [String]
             | TypeClass String
             | TypeArray RhsType
             deriving (Show, Eq)

data InterfaceField = InterfaceField String Bool RhsType
                    deriving (Show, Eq)

data Interface = Interface Bool String (Maybe String) [InterfaceField]
               deriving (Show, Eq)

data Type = Type Bool String RhsType

parseId :: Parser String
parseId = do
  first <- letter
  rest <- many alphaNum
  return $ first : rest

parseFieldTypeString :: Parser RhsType
parseFieldTypeString = do
  string "string"
  return TypeString

parseFieldTypeBoolean :: Parser RhsType
parseFieldTypeBoolean = do
  string "boolean"
  return TypeBoolean

parseFieldTypeNumber :: Parser RhsType
parseFieldTypeNumber = do
  string "number"
  return TypeNumber

parseFieldTypeEnum :: Parser RhsType
parseFieldTypeEnum = do
  items <- sepBy1 parseEnumItem parseEnumDelim
  return $ TypeEnum items
  where
    parseEnumItem = do
      spaces
      char '\''
      str <- many $ alphaNum <|> char '_'
      char '\''
      spaces
      return str
    parseEnumDelim = char '|'

parseFieldTypeClass :: Parser RhsType
parseFieldTypeClass = do
  first <- upper
  rest <- many alphaNum
  return $ TypeClass $ first:rest

parseRawFieldType :: Parser RhsType
parseRawFieldType = parseFieldTypeString <|>
    parseFieldTypeBoolean <|>
    parseFieldTypeNumber <|>
    parseFieldTypeEnum <|>
    parseFieldTypeClass

isParsed :: Parser a -> Parser Bool
isParsed p = isJust <$> optionMaybe p

parseRhsType :: Parser RhsType
parseRhsType = do
  rawFieldType <- parseRawFieldType
  isArray <- isParsed $ string "[]"
  let fieldType = if isArray then TypeArray rawFieldType else rawFieldType
  return fieldType

parseInterfaceField :: Parser InterfaceField
parseInterfaceField = do
  spaces
  name <- parseId
  isOpt <- isParsed $ char '?'
  char ':'
  spaces
  fType <- parseRhsType
  spaces
  char ';'
  return $ InterfaceField name isOpt fType

parseInterface :: Parser Interface
parseInterface = do
  spaces
  isExported <- isParsed $ string "export"
  spaces
  string "interface"
  spaces
  name <- parseId
  spaces
  extOpt <- optionMaybe parseExtends
  spaces
  char '{'
  spaces
  items <- sepEndBy parseInterfaceField spaces
  char '}'
  return $ Interface isExported name extOpt items
  where
    parseExtends :: Parser String
    parseExtends = do
      string "extends"
      spaces
      parseId

parseType :: Parser Type
parseType = do
  spaces
  isExported <- isParsed $ string "export"
  spaces
  string "type"
  spaces
  name <- parseId
  spaces
  char '='
  spaces
  fType <- parseRhsType
  spaces
  char ';'
  return $ Type isExported name fType

typeToJoi :: RhsType -> String
typeToJoi t = case t of
    TypeString -> "Joi.string()"
    TypeNumber -> "Joi.number()"
    TypeBoolean -> "Joi.boolean()"
    TypeEnum xs -> "Joi.string().valid(" ++ (xs & map (\x->"'"++x++"'") & intercalate ", ") ++ ")"
    TypeClass c -> "create" ++ c ++ "Schema()"
    TypeArray a -> "Joi.array().items(" ++ typeToJoi a ++ ")"

toFieldOfJoi :: InterfaceField -> String
toFieldOfJoi (InterfaceField name opt t) = name ++ ": " ++ innerPart ++ requiredPart where
  requiredPart = if opt then "" else ".required()"
  innerPart = typeToJoi t

capitalize :: String -> String
capitalize ""     = ""
capitalize (x:xs) = toUpper x : xs

getSchemaCreatorName :: String -> String
getSchemaCreatorName name = "create" ++ capitalize name ++ "Schema"

convertInterfaceToJoiSchema :: String -> Either String String
convertInterfaceToJoiSchema input = output where
  parsed = parse parseInterface "" input
  output = case parsed of
    Left err -> Left $ "Failed to parse interface: " ++ show err
    Right x  -> Right $ f x
  f (Interface exported name extendsOpt fields) = expPart ++ "const " ++ namePart ++ " = () => " ++
   creatorPart ++ "\n" ++ fieldsPart ++ "\n" ++ endPart ++ ";" where
    expPart = if exported then "export " else ""
    namePart = getSchemaCreatorName name
    creatorPart = case extendsOpt of
      Nothing -> "Joi.object({"
      Just e  -> getSchemaCreatorName e ++ "().keys({"
    endPart = "})"
    fieldsPart = fields & map toFieldOfJoi & map (\x->"  "++x++",") & intercalate "\n" & removeLastComma
    removeLastComma "" = ""
    removeLastComma xs = if last xs == ',' then init xs else xs

convertTypeToJoiSchema :: String -> Either String String
convertTypeToJoiSchema input = output where
  parsed = parse parseType "" input
  output = case parsed of
    Left err -> Left $ "Failed to parse type declaration: " ++ show err
    Right x  -> Right $ f x
  f (Type exported name typ) = expPart ++ "const " ++ namePart ++ " = () => " ++ joiCall ++ ";" where
    expPart = if exported then "export " else ""
    namePart = getSchemaCreatorName name
    joiCall = typeToJoi typ

main :: IO ()
main = do
  putStrLn "* JoiFromTypeScript by monnef *\n"
  clb <- getClipboard
  putStrLn $ ">> Old clipboard:\n\n" ++ clb
  let newClb = convertTypeToJoiSchema clb <|> convertInterfaceToJoiSchema clb
  case newClb of
    Left err -> putStrLn $ "error: " ++ err
    Right res -> do
      putStrLn $ "\n>> Setting clipboard to:\n\n" ++ res
      setClipboard res