{-# LANGUAGE LambdaCase #-}

-- |
-- Module      : Jikka.Subcommand.Convert
-- Description : is the entry point of @convert@ subcommand. / @convert@ サブコマンドのエントリポイントです。
-- Copyright   : (c) Kimiyuki Onaka, 2021
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.Main.Subcommand.Convert (run) where

import Data.Text (Text, pack)
import qualified Jikka.CPlusPlus.Convert as FromCore
import qualified Jikka.CPlusPlus.Format as FormatCPlusPlus
import Jikka.Common.Alpha
import Jikka.Common.Error
import qualified Jikka.Core.Convert as Convert
import qualified Jikka.Core.Format as FormatCore
import Jikka.Main.Target
import qualified Jikka.Python.Convert.ToRestrictedPython as ToRestrictedPython
import qualified Jikka.Python.Parse as ParsePython
import qualified Jikka.RestrictedPython.Convert as ToCore
import qualified Jikka.RestrictedPython.Format as FormatRestrictedPython

runPython :: FilePath -> Text -> Either Error Text
runPython :: FilePath -> Text -> Either Error Text
runPython FilePath
path Text
input = (AlphaT (Either Error) Text -> Int -> Either Error Text)
-> Int -> AlphaT (Either Error) Text -> Either Error Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip AlphaT (Either Error) Text -> Int -> Either Error Text
forall (m :: * -> *) a. Functor m => AlphaT m a -> Int -> m a
evalAlphaT Int
0 (AlphaT (Either Error) Text -> Either Error Text)
-> AlphaT (Either Error) Text -> Either Error Text
forall a b. (a -> b) -> a -> b
$ do
  Program
prog <- FilePath -> Text -> AlphaT (Either Error) Program
forall (m :: * -> *).
MonadError Error m =>
FilePath -> Text -> m Program
ParsePython.run FilePath
path Text
input
  Text -> AlphaT (Either Error) Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> AlphaT (Either Error) Text)
-> (FilePath -> Text) -> FilePath -> AlphaT (Either Error) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack (FilePath -> AlphaT (Either Error) Text)
-> FilePath -> AlphaT (Either Error) Text
forall a b. (a -> b) -> a -> b
$ Program -> FilePath
forall a. Show a => a -> FilePath
show Program
prog -- TODO

runRestrictedPython :: FilePath -> Text -> Either Error Text
runRestrictedPython :: FilePath -> Text -> Either Error Text
runRestrictedPython FilePath
path Text
input = (AlphaT (Either Error) Text -> Int -> Either Error Text)
-> Int -> AlphaT (Either Error) Text -> Either Error Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip AlphaT (Either Error) Text -> Int -> Either Error Text
forall (m :: * -> *) a. Functor m => AlphaT m a -> Int -> m a
evalAlphaT Int
0 (AlphaT (Either Error) Text -> Either Error Text)
-> AlphaT (Either Error) Text -> Either Error Text
forall a b. (a -> b) -> a -> b
$ do
  Program
prog <- FilePath -> Text -> AlphaT (Either Error) Program
forall (m :: * -> *).
MonadError Error m =>
FilePath -> Text -> m Program
ParsePython.run FilePath
path Text
input
  Program
prog <- Program -> AlphaT (Either Error) Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m Program
ToRestrictedPython.run Program
prog
  (Program
prog, IOFormat
_) <- Program -> AlphaT (Either Error) (Program, IOFormat)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m (Program, IOFormat)
ToCore.run' Program
prog
  Program -> AlphaT (Either Error) Text
forall (m :: * -> *). Applicative m => Program -> m Text
FormatRestrictedPython.run Program
prog

runCore :: FilePath -> Text -> Either Error Text
runCore :: FilePath -> Text -> Either Error Text
runCore FilePath
path Text
input = (AlphaT (Either Error) Text -> Int -> Either Error Text)
-> Int -> AlphaT (Either Error) Text -> Either Error Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip AlphaT (Either Error) Text -> Int -> Either Error Text
forall (m :: * -> *) a. Functor m => AlphaT m a -> Int -> m a
evalAlphaT Int
0 (AlphaT (Either Error) Text -> Either Error Text)
-> AlphaT (Either Error) Text -> Either Error Text
forall a b. (a -> b) -> a -> b
$ do
  Program
prog <- FilePath -> Text -> AlphaT (Either Error) Program
forall (m :: * -> *).
MonadError Error m =>
FilePath -> Text -> m Program
ParsePython.run FilePath
path Text
input
  Program
prog <- Program -> AlphaT (Either Error) Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m Program
ToRestrictedPython.run Program
prog
  (Program
prog, IOFormat
_) <- Program -> AlphaT (Either Error) (Program, IOFormat)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m (Program, IOFormat)
ToCore.run Program
prog
  Program
prog <- Program -> AlphaT (Either Error) Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m Program
Convert.run Program
prog
  Program -> AlphaT (Either Error) Text
forall (m :: * -> *). Applicative m => Program -> m Text
FormatCore.run Program
prog

runCPlusPlus :: FilePath -> Text -> Either Error Text
runCPlusPlus :: FilePath -> Text -> Either Error Text
runCPlusPlus FilePath
path Text
input = (AlphaT (Either Error) Text -> Int -> Either Error Text)
-> Int -> AlphaT (Either Error) Text -> Either Error Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip AlphaT (Either Error) Text -> Int -> Either Error Text
forall (m :: * -> *) a. Functor m => AlphaT m a -> Int -> m a
evalAlphaT Int
0 (AlphaT (Either Error) Text -> Either Error Text)
-> AlphaT (Either Error) Text -> Either Error Text
forall a b. (a -> b) -> a -> b
$ do
  Program
prog <- FilePath -> Text -> AlphaT (Either Error) Program
forall (m :: * -> *).
MonadError Error m =>
FilePath -> Text -> m Program
ParsePython.run FilePath
path Text
input
  Program
prog <- Program -> AlphaT (Either Error) Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m Program
ToRestrictedPython.run Program
prog
  (Program
prog, IOFormat
format) <- Program -> AlphaT (Either Error) (Program, IOFormat)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m (Program, IOFormat)
ToCore.run Program
prog
  Program
prog <- Program -> AlphaT (Either Error) Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m Program
Convert.run Program
prog
  Int -> AlphaT (Either Error) ()
forall (m :: * -> *). Monad m => Int -> AlphaT m ()
resetAlphaT Int
0 -- to make generated C++ code cleaner
  Program
prog <- Program -> IOFormat -> AlphaT (Either Error) Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> IOFormat -> m Program
FromCore.run Program
prog IOFormat
format
  Program -> AlphaT (Either Error) Text
forall (m :: * -> *). Applicative m => Program -> m Text
FormatCPlusPlus.run Program
prog

run :: Target -> FilePath -> Text -> Either Error Text
run :: Target -> FilePath -> Text -> Either Error Text
run = \case
  Target
PythonTarget -> FilePath -> Text -> Either Error Text
runPython
  Target
RestrictedPythonTarget -> FilePath -> Text -> Either Error Text
runRestrictedPython
  Target
CoreTarget -> FilePath -> Text -> Either Error Text
runCore
  Target
CPlusPlusTarget -> FilePath -> Text -> Either Error Text
runCPlusPlus