ddc-tools-0.3.1.1: src/ddci-core/DDCI/Core/Input.hs
module DDCI.Core.Input
( InputState (..)
, Input (..)
, readInput
, eatLine)
where
import DDCI.Core.State
import DDCI.Core.Command
import DDCI.Core.Command.TransInteract
import DDC.Data.ListUtils
import System.Directory
import Data.List
import Data.Char
-- InputState ----------------------------------------------------------------------
-- Interpreter input state
data InputState
= InputState
{ -- Command that we're still receiving input for,
-- along with the line number it started on.
inputCommand :: Maybe (Command, Int)
-- Input mode.
, _inputMode :: Input
-- The current line number in the command stream.
, inputLineNumber :: Int
-- Accumulation of current input buffer.
, _inputAcc :: String }
-- | How we're reading the input expression.
data Input
-- | Read input line-by-line, using a backslash at the end of the
-- line to continue to the next.
= InputLine
-- | Read input as a block terminated by a double semicolon (;;)
| InputBlock
-- | Read input from a file specified on the prompt
| InputFile FilePath
deriving (Eq, Show)
-- | Read the input mode from the front of a string.
readInput :: String -> (Input, String)
readInput ss
| isPrefixOf ".." ss
= (InputBlock, drop 2 ss)
| isPrefixOf "<" ss
, filePath <- dropWhile isSpace (drop 1 ss)
= (InputFile filePath, drop (length filePath) ss)
| otherwise
= (InputLine, ss)
-- Eat ------------------------------------------------------------------------
-- Eating input lines.
eatLine :: State -> InputState -> String -> IO (State, InputState)
eatLine state (InputState mCommand inputMode lineNumber acc) line
| Just _ <- stateTransInteract state
= do
state' <- cmdTransInteractLoop state line
return (state', InputState mCommand inputMode (lineNumber+1) acc)
| otherwise
= do
-- If this is the first line then try to read the command and
-- input mode from the front so we know how to continue.
-- If we can't read an explicit command then assume this is
-- an expression to evaluate.
let (cmd, lineStart, (input, rest))
= case mCommand of
-- We haven't started a command yet.
Nothing
-> case readCommand line of
Just (cmd', rest') -> (cmd', lineNumber, readInput rest')
Nothing -> (CommandEval, lineNumber, (InputLine, line))
-- We've already started a command, and this is more input for it.
Just (cmd', lineStart')
-> (cmd', lineStart', (inputMode, line))
let source
-- We were instructed to read the program from a file.
-- Report this file as the source location, independent
-- of how we were instructed to read it.
| InputFile filePath <- input
= SourceFile filePath
-- The program was embedded in the command stream.
| otherwise
= case stateInterface state of
InterfaceArgs -> SourceArgs
InterfaceConsole -> SourceConsole lineStart
InterfaceBatch file -> SourceBatch file lineStart
case input of
-- For line-by-line mode, if the line ends with backslash then keep
-- reading, otherwise run the command.
-- We also convert the backslash to a newline so the source
-- position comes out right in parser error messages.
InputLine
| not $ null rest
, last rest == '\\'
, Just initRest <- takeInit rest
-> do return ( state
, InputState (Just (cmd, lineStart)) input
(lineNumber + 1)
(acc ++ initRest ++ "\n"))
| otherwise
-> do state' <- handleCmd state cmd source (acc ++ rest)
return ( state'
, InputState Nothing InputLine
(lineNumber + 1)
[])
-- For block mode, if the line ends with ';;' then run the command,
-- otherwise keep reading.
InputBlock
| isSuffixOf ";;" rest
-> do let rest' = take (length rest - 2) rest
state' <- handleCmd state cmd source (acc ++ rest')
return ( state'
, InputState Nothing InputLine
(lineNumber + 1)
[])
| otherwise
-> return ( state
, InputState (Just (cmd, lineStart)) input
(lineNumber + 1)
(acc ++ rest ++ "\n"))
-- Read input from a file
InputFile filePath
-> do exists <- doesFileExist filePath
if exists
then do
contents <- readFile filePath
state' <- handleCmd state cmd source contents
return ( state'
, InputState Nothing InputLine
(lineNumber + 1)
[])
else do
putStrLn "No such file."
return ( state
, InputState Nothing InputLine
(lineNumber + 1)
[])