packages feed

tdlib-gen-0.1.0: app/Main.hs

module Main where

import Codegen
import Data.Text (Text)
import qualified Data.Text.IO as T
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Internal
import Language.TL.Parser
import Processing
import Text.Megaparsec

dataDeclHeader :: Text -> Doc ann
dataDeclHeader mname =
  let m = unsafeTextWithoutNewlines mname
   in vsep
        [ "{-# LANGUAGE DeriveGeneric #-}",
          "{-# LANGUAGE DeriveAnyClass #-}",
          "{-# LANGUAGE DerivingStrategies #-}",
          "{-# LANGUAGE DuplicateRecordFields #-}",
          "{-# LANGUAGE TemplateHaskell #-}",
          "",
          "-- | TD API data types generated by tdlib-gen",
          "module" <+> m <+> "where",
          "",
          "import GHC.Generics",
          "import Language.Haskell.Codegen.TH",
          "import Data.ByteString.Base64.Type",
          "import qualified Data.Text as T",
          "import Language.TL.I64",
          "",
          "type I53 = Int",
          "type I32 = Int",
          "type T = T.Text"
        ]

funArgHeader :: Text -> Text -> Doc ann
funArgHeader mname dep =
  let m = unsafeTextWithoutNewlines mname
      d = unsafeTextWithoutNewlines dep
   in vsep
        [ "{-# LANGUAGE DeriveGeneric #-}",
          "{-# LANGUAGE DeriveAnyClass #-}",
          "{-# LANGUAGE DerivingStrategies #-}",
          "{-# LANGUAGE DuplicateRecordFields #-}",
          "{-# LANGUAGE TemplateHaskell #-}",
          "",
          "-- | TD API function call arguments",
          "module" <+> m <+> "where",
          "",
          "import GHC.Generics",
          "import Language.Haskell.Codegen.TH",
          "import Data.ByteString.Base64.Type",
          "import qualified Data.Text as T",
          "import Language.TL.I64",
          "import" <+> d,
          "",
          "type I53 = Int",
          "type I32 = Int",
          "type T = T.Text"
        ]

funHeader :: Text -> Text -> Doc ann
funHeader mod dep =
  let m = unsafeTextWithoutNewlines mod
      d = unsafeTextWithoutNewlines dep
   in vsep
        [ "{-# LANGUAGE TypeOperators #-}",
          "-- | TD API functions (methods) generated by tdlib-gen",
          "module" <+> m <+> "where",
          "",
          "import TDLib.Effect",
          "import Polysemy",
          "import" <+> d,
          ""
        ]

sep' :: Doc ann
sep' = "-- * Function Arguments"

main :: IO ()
main = do
  putStrLn "tl file path:"
  fp <- getLine
  f <- T.readFile fp
  let mprog = runParser program "td_api.tl" f
  case mprog of
    Left _ -> error "parse failed"
    Right prog -> do
      let (datas, functions) = convProgram prog
      let adts = fmap (convADT defTyMap) datas
      let funDefs = fmap (convFun defTyMap) functions
      putStrLn "module name for generated data declerations:"
      modName1 <- T.getLine
      putStrLn "module name for generated function definitions:"
      modName2 <- T.getLine
      putStrLn "module name for generated function arguments:"
      modName3 <- T.getLine
      let adts' = fmap paramADT funDefs
      let file1 = dataDeclHeader modName1 <> "\n\n" <> vsep (fmap pretty adts) <> "\n\n" <> "instanceDec"
      let file2 = funHeader modName2 modName3 <> "\n\n" <> vsep (fmap pretty funDefs)
      let file3 = funArgHeader modName3 modName1 <> "\n\n" <> vsep (fmap pretty adts') <> "\n\n" <> "instanceDec'"
      writeFile "Types.hs" (show file1)
      writeFile "Functions.hs" (show file2)
      writeFile "FunArgs.hs" (show file3)