blob: e3fdd7a380bffa4fcc0107ba9e8d31e6307950fc (
plain)
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
|
import Control.Monad
import Options.Applicative
import Data.Aeson
import qualified Data.ByteString.Lazy as B
import System.FilePath
import Data.Version
import Paths_lambdacube_compiler (version)
import LambdaCube.Compiler
addInfo i p = info (helper <*> p) i
main :: IO ()
main = join $ execParser $ addInfo i $ subparser (
command "compile" (addInfo (progDesc "compiles LambdaCube3D source to JSON IR") compile')
<> command "parse" (addInfo (progDesc "parses LambdaCube3D source") $ parse
<$> argument str (metavar "SOURCE_FILE")
<*> flag OpenGL33 WebGL1 (long "webgl" <> help "generate WebGL 1.0 pipeline" )
<*> pure ["."]
<*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name"))
)
<> command "pretty" (addInfo (progDesc "pretty prints JSON IR") $ prettyPrint
<$> argument str (metavar "SOURCE_FILE")
<*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name"))
)) <|> compile'
where
compile' = (compile
<$> argument str (metavar "SOURCE_FILE")
<*> flag OpenGL33 WebGL1 (long "webgl" <> help "generate WebGL 1.0 pipeline" )
<*> pure ["."]
<*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name"))
)
i = fullDesc
<> progDesc "executes command (default to compile if no command is given)"
<> header ("LambdaCube 3D compiler " ++ showVersion version)
prettyPrint srcName output = do
let baseName = dropExtension srcName
withOutName n = maybe n id output
json <- B.readFile srcName
case eitherDecode json :: Either String Pipeline of
Left err -> putStrLn err
Right ppl -> writeFile (withOutName $ baseName <> ".ppl") $ prettyShowUnlines ppl
parse srcName backend includePaths output = do
pplRes <- parseModule includePaths srcName
case pplRes of
Left err -> fail $ show err
Right ppl -> maybe (putStrLn ppl) (`writeFile` ppl) output
compile srcName backend includePaths output = do
let ext = takeExtension srcName
baseName | ext == ".lc" = dropExtension srcName
| otherwise = srcName
withOutName n = maybe n id output
do
pplRes <- compileMain includePaths backend srcName
case pplRes of
Left err -> fail $ show err
Right ppl -> B.writeFile (withOutName $ baseName <> ".json") $ encode ppl
-- True -> writeFile (withOutName $ baseName <> ".ppl") $ prettyShowUnlines ppl
|
