Something went wrong. Try again.
Define datatypes once, get polyglot results
Something went wrong. Try again.
6.3 kB · 166 lines
Haskell
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167module Main where
import qualified Antelude.File as Fileimport qualified Antelude.IO as IOimport qualified Antelude.List as Listimport qualified Antelude.List.NonEmpty as NEimport qualified Antelude.Maybe as Maybeimport qualified Antelude.Monad as Monadimport qualified Antelude.String as String
import qualified Control.Monad as CtrlMonad
import qualified Data.Map.Strict as Mapimport qualified Data.Text as Text
import DataTypeTool.Cli ( Flags, tomlPath )import qualified DataTypeTool.Cli as Cliimport qualified DataTypeTool.Common.Utils as Comimport qualified DataTypeTool.Config.Config as Configimport DataTypeTool.Lang.DTT.Default ( defaultTypes, newToml )import qualified DataTypeTool.Parsing.Parser as Parserimport qualified DataTypeTool.Parsing.Types as PT
import qualified Options.Applicative as Opts
import qualified System.Directory as Dirimport qualified System.Exit as Exit ( die )import System.FilePath ( pathSeparator )
import qualified Text.Megaparsec as MP
import qualified Toml
main :: IO ()main = do cwd <- Dir.getCurrentDirectory Opts.execParser (Cli.opts cwd) >>= run where run :: Flags -> IO () run flags = do -- Do we have a Toml? If not, ask to make one. Dir.doesFileExist flags.tomlPath >>= \case True -> return () False -> askToGenerateToml flags.tomlPath -- Decode the toml >> Toml.decodeFileEither Config.datatypetoolCodec flags.tomlPath >>= \case Left tomlErrs -> Toml.prettyTomlDecodeErrors tomlErrs |> String.unText |> Exit.die Right config -> runWithConfig flags.tomlPath config
runWithConfig :: FilePath -> Config.Config -> IO () runWithConfig tomlPath config = let tomlDir :: FilePath -> FilePath tomlDir = List.reverse .> List.dropWhile (/= pathSeparator) .> List.drop 1 .> List.reverse
mkTypeDir :: FilePath -> IO FilePath mkTypeDir tomlAbsFp = Dir.canonicalizePath ( tomlDir tomlAbsFp <> [pathSeparator] <> Config.sources config )
absTomlDir :: FilePath -> FilePath absTomlDir = List.reverse .> List.dropWhile (/= pathSeparator) .> List.reverse
runWriter :: FilePath -> Pair FilePath PT.DataTypeFile -> Config.LangConfiguration -> IO () runWriter absTomlPath (fp, res) target = Config.runLangWriter target (absTomlDir absTomlPath) [(fp, res)]
handleParsingResults :: FilePath -> Pair FilePath (Either (MP.ParseErrorBundle String Void) PT.DataTypeFile ) -> IO () handleParsingResults absTomlPath (fp, res) = case res of Left l -> IO.putStrLn ("Some error occurred: " <> show l) Right r -> -- Generate types from the results Monad.mapM_ (runWriter absTomlPath (fp, r)) (NE.toList config.targets) in do absTomlPath <- Dir.canonicalizePath tomlPath absTypeDir <- mkTypeDir absTomlPath
-- Filter for valid directories Dir.doesDirectoryExist absTypeDir -- Do we have the type directory from the Toml? -- If not, ask to make it. >>= \case True -> return () False -> askToGenerateTypeExample absTypeDir config -- Parse the type files >> Parser.runParsers absTypeDir config >>= Monad.mapM_ (handleParsingResults absTomlPath)
askToGenerateToml :: FilePath -> IO () askToGenerateToml tomlPath = do IO.putStrLn "No valid datatypetool.toml found in current directory." IO.putStrLn "Would you like to generate one? (y/n)" answer <- IO.getLine if | List.contains answer Cli.yeses -> IO.putStrLn "Creating default toml." >> File.writeFile tomlPath newToml | List.contains answer Cli.nos -> Exit.die "No toml found. Ending." | otherwise -> Exit.die ("Unknown option: " <> answer)
askToGenerateTypeExample :: FilePath -> Config.Config -> IO () askToGenerateTypeExample absTypeDir config = do IO.putStrLn "Directory where types are said to exist does not exist." IO.putStrLn "Would you like to generate this directory with an example? (y/n)" answer <- IO.getLine if | List.contains answer Cli.yeses -> IO.putStrLn "Creating default types." >> Dir.createDirectoryIfMissing True absTypeDir >> File.writeFile (absTypeDir <> "/Example.type") (defaultTypes config.spacing) | List.contains answer Cli.nos -> Exit.die "No types found. Ending." | otherwise -> Exit.die ("Unknown option: " <> answer)