Echo Writes Code

Main.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
import Orchid.Tokenizer (runTokenizer)
import Orchid.Parser (runParser)
import Orchid.Data (Token(..), renderToken, describeToken, Statement(..))

import qualified Data.Text.IO.Utf8 as Text.IO
import Data.Text (Text)

import qualified Options.Applicative as Options
import Options.Applicative ((<**>))

import qualified System.IO

import qualified Text.Colour.Chunk as Colors
import qualified Text.Colour.Capabilities as TerminalCapabilities

data Arguments =
	TokenizeArguments { sourceFile :: Maybe String, outputFile :: Maybe String } |
	ParseArguments { sourceFile :: Maybe String, outputFile :: Maybe String }

makeArgumentParser :: Options.ParserInfo Arguments
makeArgumentParser = Options.info
	(parseArguments <**> Options.helper)
	(Options.fullDesc <> Options.progDesc "Transforms an Orchid source file into another form" <> Options.header "orchid-cli: The Orchid language command-line interface")

parseArguments :: Options.Parser Arguments
parseArguments = do
	let tokenize = do
		sourceFile <- parseSourceFile
		outputFile <- parseOutputFile
		return TokenizeArguments { .. }

	let parse = do
		sourceFile <- parseSourceFile
		outputFile <- parseOutputFile
		return ParseArguments { .. }

	Options.hsubparser (
		Options.command "tokenize" (Options.info tokenize (Options.progDesc "Tokenize an Orchid source file")) <>
		Options.command "parse" (Options.info parse (Options.progDesc "Parse an Orchid source file")))

parseSourceFile :: Options.Parser (Maybe String)
parseSourceFile = Options.optional $ Options.strArgument (Options.metavar "SOURCE_FILE" <> Options.help "The source file to process")

parseOutputFile :: Options.Parser (Maybe String)
parseOutputFile = Options.optional $ Options.strOption (Options.short 'o' <> Options.long "output-file" <> Options.metavar "OUTPUT_FILE" <> Options.help "The output file to process")

main :: IO ()
main = do
	arguments <- Options.execParser makeArgumentParser
	runOrchidToolchain arguments

runOrchidToolchain :: Arguments -> IO ()

runOrchidToolchain (TokenizeArguments sourceFile outputFile) = do
	source <- readSourceFile sourceFile
	let result = runTokenizer (filenameOf sourceFile) source
	case result of
		Left e -> putStrLn e
		Right tokens -> renderTokens outputFile tokens

runOrchidToolchain (ParseArguments sourceFile outputFile) = do
	source <- readSourceFile sourceFile
	let result = runParser (filenameOf sourceFile) source
	case result of
		Left e -> putStrLn e
		Right statements -> renderStatements outputFile statements

filenameOf :: Maybe String -> String
filenameOf (Just filename) = filename
filenameOf Nothing = "<standard input>"

readSourceFile :: Maybe String -> IO Text
readSourceFile (Just sourceFile) = Text.IO.readFile sourceFile
readSourceFile Nothing = Text.IO.getContents

renderTokens :: Maybe String -> [Token] -> IO ()
renderTokens outputFile tokens = do
	outputHandle <- case outputFile of
		Just path -> System.IO.openFile path System.IO.WriteMode
		Nothing -> return System.IO.stdout
	mapM_ (Text.IO.hPutStrLn outputHandle . displayToken) tokens
	System.IO.hClose outputHandle

renderStatements :: Maybe String -> [Statement] -> IO ()
renderStatements outputFile statements = do
	outputHandle <- case outputFile of
		Just path -> System.IO.openFile path System.IO.WriteMode
		Nothing -> return System.IO.stdout
	mapM_ (Text.IO.hPutStrLn outputHandle . displayStatement) statements
	System.IO.hClose outputHandle

displayToken :: Token -> Text
displayToken token = "> " <> description <> ": " <> colorRepresentation representation where
	representation = renderToken token
	description = describeToken token

displayStatement :: Statement -> Text
displayStatement _ = "placeholder"

colorRepresentation :: Text -> Text
colorRepresentation text = Colors.renderChunkText TerminalCapabilities.With8Colours colored where
	colored = Colors.fore Colors.cyan chunk
	chunk = Colors.chunk text