diff options
Diffstat (limited to 'fig-bless/main/Main.hs')
| -rw-r--r-- | fig-bless/main/Main.hs | 37 |
1 files changed, 26 insertions, 11 deletions
diff --git a/fig-bless/main/Main.hs b/fig-bless/main/Main.hs index ea9531d..c43bfc6 100644 --- a/fig-bless/main/Main.hs +++ b/fig-bless/main/Main.hs @@ -20,7 +20,7 @@ import qualified Fig.Bless.Syntax as Syn data EvalOptions = EvalOptions { src :: Text , fuel :: Maybe Integer - } + } deriving Show parseEvalOptions :: Parser EvalOptions parseEvalOptions = do @@ -30,7 +30,7 @@ parseEvalOptions = do newtype TypeOptions = TypeOptions { src :: Text - } + } deriving Show parseTypeOptions :: Parser TypeOptions parseTypeOptions = do @@ -41,7 +41,7 @@ data DictionaryOptions = DictionaryOptions { path :: FilePath , entrypoint :: Word , fuel :: Maybe Integer - } + } deriving Show parseDictionaryOptions :: Parser DictionaryOptions parseDictionaryOptions = do @@ -54,6 +54,7 @@ data Command = Eval EvalOptions | Type TypeOptions | Dict DictionaryOptions + deriving Show parseCommand :: Parser Command parseCommand = subparser $ mconcat @@ -65,7 +66,7 @@ parseCommand = subparser $ mconcat data Options = Options { cmd :: Command , json :: Bool - } + } deriving Show parseOptions :: Parser Options parseOptions = do @@ -75,9 +76,23 @@ parseOptions = do writeError :: (MonadIO m, Pretty e, Aeson.ToJSON e) => Options -> e -> m () writeError o e - | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict $ Aeson.encode e + | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict . Aeson.encode $ Aeson.object + [ "status" Aeson..= ("error" :: Text) + , "data" Aeson..= Aeson.object + [ "structure" Aeson..= e + , "message" Aeson..= pretty e + ] + ] | otherwise = liftIO . hPutStrLn stderr $ pretty e +writeSuccess :: (MonadIO m, Pretty e, Aeson.ToJSON e) => Options -> e -> m () +writeSuccess o e + | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict . Aeson.encode $ Aeson.object + [ "status" Aeson..= ("success" :: Text) + , "data" Aeson..= e + ] + | otherwise = liftIO . putStrLn $ pretty e + main :: IO () main = do opts <- execParser $ info (parseOptions <**> helper) @@ -96,13 +111,13 @@ main = do let stack :: [ValueF Spanning (Fix (ValueF Spanning))] stack = vm'.stack - forM_ stack $ putStrLn . pretty + writeSuccess opts stack Type to -> do prog <- parse "<input>" (programF spanning <* eof) to.src let ?term = Nothing let ext = pure . unSpanning ty <- typeOfProgram (initializeEnv ext builtins) prog - putStrLn $ pretty ty + writeSuccess opts ty Dict o -> do src <- T.IO.readFile o.path dict <- parse "<input>" (dictionaryF spanning <* eof) src @@ -114,9 +129,9 @@ main = do let stack :: [ValueF Spanning (Fix (ValueF Spanning))] stack = vm'.stack - forM_ stack $ putStrLn . pretty + writeSuccess opts stack ) - [ Handler \(e :: Syn.ParseError) -> hPutStrLn stderr $ pretty e - , Handler \(e :: RuntimeError Spanning) -> hPutStrLn stderr $ pretty e - , Handler \(e :: TypeError Spanning) -> hPutStrLn stderr $ pretty e + [ Handler \(e :: Syn.ParseError) -> writeError opts e + , Handler \(e :: RuntimeError Spanning) -> writeError opts e + , Handler \(e :: TypeError Spanning) -> writeError opts e ] |
