{-
 - By Ørjan Johansen 2013-2018.
 - License: CC0.
 -
 - 2018: Updated to new representation that can coexist with other
 - computations in the same queue.
 - Added -S option.
 -
 - Automatic conversion of a subset of Underload to Fueue.  The only
 - restriction is that S can only be translated as a command when it literally
 - follows a parenthesized element in the program.
 -
 - Programs that never use the same element as runnable program and printable
 - text can be converted into this form by replacing lone S by ^ and printable
 - text elements (...) by ((...)S).
 -
 - The -S option can add this conversion automatically for programs that
 - never print an Underload command character except in a literal (...)S
 - command. However, expect strange errors if they do.
 -}

{-#LANGUAGE OverloadedStrings #-}

import Control.Applicative hiding ((<|>),many)
import Data.Bifunctor (first)
import Data.Monoid ((<>))
import Data.String (IsString(..))
import System.Environment (getArgs,getProgName)
import System.IO (hPutStrLn, stderr)
import Text.Parsec

data Cmd = Ch Char | Par [Cmd] | Print String
instance Show Cmd where
    show (Ch c) = [c]
    show (Par l) = '(' : show l <> ")"
    show (Print s) = '(' : s <> ")S"
    showList = flip (foldr shows)

instance IsString b => IsString (a -> b) where
    fromString = pure . fromString

cmdList :: Parsec String () [Cmd]
cmdList = many cmd

cmd :: Parsec String () Cmd
cmd = ((char '(' *> cmdList <* char ')')
      <**> option Par (Print . show <$ char 'S')
    <|> Ch <$> noneOf ")") <?> "command character"

convertCmd :: Cmd -> Bool -> String
convertCmd (Ch '~') = "~[)~~[~[:~)<(]~)~)]<[<(]])~)~)"
                    --"~[)~~[~[~)~~<~(]~)~)]<[<(]])~)~)"
convertCmd (Ch ':') = ")~)[)~([~~)<]~!]:"
                    --")~)[)~([~)~<]~!]:"
convertCmd (Ch '!') = ":~~!))"
                    --"$~!1)~)"
convertCmd (Ch '*') = "):~[):~[)~<~[:~~<)(]:~<]~[)~~]<~<][):~~<]~)~)"
                    --")[~[)~~~[~)~~~~<~(~<][~<~~~~<~(]<~)]~)~<<[~[)~)~])]~)])"
convertCmd (Par l) = "~~)<[[" <> convertCmdList l <> "]]"
                   --"~[[" <> convertCmdList l <> "]]<~)"
convertCmd (Ch 'a') = ")~<~[:~~<)(]~([~~)<])"
                    --")~<~[~)~~<~(]~([~)~<])"
convertCmd (Ch '^') = "))"
                    --No change
convertCmd (Print s) = convertMessage s <> ")~"
                     --convertMessage s <> "~)"
convertCmd (Ch 'S') = convertPrint (Ch '^') "lone S"
convertCmd (Ch c) = convertPrint (Print [c]) "bad insn"

convertCmdList :: [Cmd] -> Bool -> String
convertCmdList [] = ")~"
                  --"~)"
convertCmdList l = foldr1 append $ map convertCmd l
  where append a b = "):~~<[" <> a <> "][)[" <> b <>"]~]~"
                   --")~~[~))[[" <> b <> "]" <> a <> "]~<]<~(" -- old version
                   --"):~~<[" <> a <> "][)~~[" <> b <> "]]~" -- for *

convertPrint cmd msg b
  | b         = convertCmd cmd b
  | otherwise = convertError msg b

convertError, convertMessage :: String -> Bool -> String
convertError e = convertMessage ("..." <> e <> "!\n") <> "H"
convertMessage = fromString . concatMap ((<>" ") . show . fromEnum)

convertProgram :: [Cmd] -> Bool -> String
convertProgram p =
    convertCmdList p <> convertEmptyStack <> " [H]"

convertEmptyStack :: Bool -> String
convertEmptyStack = "[[] " <> convertError "out of stack" <> "]"

convertProgramString :: String -> Either ParseError (Bool -> String)
convertProgramString s =
    convertProgram <$> parse (cmdList <* eof) "Input string" s

main = do
    args <- getArgs
    p <- getProgName
    either (hPutStrLn stderr) putStrLn $ case args of
        [_] -> fmap ($ False)
        ["-S",_] -> fmap ($ True)
        _ -> const . Left $
            "Usage: " ++ p ++
            " <program string> or " ++ p ++ " -S <program string>"
      $ first show $ convertProgramString (last args)