language-ninja-0.1.0: executables/ninja-parse/Main.hs
-- -*- coding: utf-8; mode: haskell; -*-
-- File: executables/ninja-parse/Main.hs
--
-- License:
-- Copyright 2017 Awake Security
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
-- |
-- Module : Main
-- Copyright : Copyright 2017 Awake Security
-- License : Apache-2.0
-- Maintainer : opensource@awakesecurity.com
-- Stability : experimental
module Main (main) where
import qualified Control.Lens as Lens
import Control.Exception (throwIO)
import Control.Monad.Except (runExceptT)
import Options.Generic ((:::), type (<?>))
import qualified Options.Generic as Opt
import GHC.Generics (Generic)
import Data.Char (toLower)
import Data.Functor (void)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Version (showVersion)
import qualified Paths_language_ninja as Paths
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Encoding as LText
import qualified Data.Text.Lazy.IO as LText
import qualified Language.Ninja.AST as AST
import qualified Language.Ninja.Errors as Errors
import qualified Language.Ninja.Lexer as Lexer
import Language.Ninja.Misc.Path (Path, pathFP, pathString)
import qualified Language.Ninja.Parser as Parser
import qualified Language.Ninja.Pretty as Pretty
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encode.Pretty as Aeson
import qualified System.IO as IO
import Flow ((.>))
--------------------------------------------------------------------------------
version :: String
version = showVersion Paths.version
--------------------------------------------------------------------------------
instance Opt.ParseField Path where
parseField h m = Lens.view (Lens.from pathFP) <$> Opt.parseField h m
composeModifiers :: Opt.Modifiers -> Opt.Modifiers -> Opt.Modifiers
composeModifiers (Opt.Modifiers fnX cnX) (Opt.Modifiers fnY cnY)
= Opt.Modifiers (fnX .> fnY) (cnX .> cnY)
removePrefixModifier :: Text -> Opt.Modifiers
removePrefixModifier prefix = Opt.Modifiers removeFN id
where
removeFN :: String -> String
removeFN str = fromMaybe str $ do
stripped <- Text.stripPrefix prefix (Text.pack str)
(c, rest) <- Text.uncons stripped
pure (toLower c : Text.unpack rest)
--------------------------------------------------------------------------------
type OptionProcessInput
= Maybe Path <?> "Read the given FILEPATH as a Ninja file."
type OptionProcessOutput
= Maybe Path <?> "Output to the given FILEPATH instead of /dev/stdout."
type OptionProcessMachineReadable
= Bool <?> "Should the output be fully machine-readable?"
type OptionPrettyInput
= Maybe Path <?> "Read the given FILEPATH as a Ninja file."
type OptionPrettyOutput
= Maybe Path <?> "Output to the given FILEPATH instead of /dev/stdout."
type OptionPrettyColor
= Bool <?> "Should the output use ANSI color?"
data Options' w
= Process { _optionsInput :: (w ::: OptionProcessInput)
, _optionsOutput :: (w ::: OptionProcessOutput)
, _optionsMachineReadable :: (w ::: OptionProcessMachineReadable) }
| Pretty { _optionsInput :: (w ::: OptionPrettyInput)
, _optionsOutput :: (w ::: OptionPrettyOutput)
, _optionsColor :: (w ::: OptionPrettyColor) }
deriving (Generic)
instance Opt.ParseRecord (Options' Opt.Wrapped) where
parseRecord = Opt.parseRecordWithModifiers
(composeModifiers
(removePrefixModifier "_options")
Opt.lispCaseModifiers)
deriving instance Show (Options' Opt.Unwrapped)
type Options = Options' Opt.Unwrapped
parseOptions :: IO Options
parseOptions = Opt.unwrapRecord (Text.pack ("ninja-parse version " <> version))
--------------------------------------------------------------------------------
processNinja :: Maybe Path -> (IO.Handle, IO.Handle) -> Bool -> IO ()
processNinja inputPath (input, output) machineReadable = do
let encodeJ :: Aeson.Value -> Text
encodeJ = (if machineReadable then Aeson.encode else Aeson.encodePretty)
.> LText.decodeUtf8 .> LText.toStrict
let throwMR :: Errors.ParseError -> IO ()
throwMR = Aeson.toJSON .> encodeJ .> Text.hPutStrLn output
inputText <- Text.hGetContents input
ast <- runExceptT $ case inputPath of
Just path -> Parser.parseFile path
Nothing -> Parser.parseText inputText
case ast of
Left e -> if machineReadable
then throwMR e
else throwIO e
Right x -> Text.hPutStr output (encodeJ (Aeson.toJSON x))
prettyNinja :: Maybe Path -> (IO.Handle, IO.Handle) -> Bool -> IO ()
prettyNinja _inputPath (input, output) _color = do
-- TODO: add color support
inputText <- LText.hGetContents input
let parsed :: Either String (AST.Ninja Lexer.Ann)
parsed = Aeson.eitherDecode (LText.encodeUtf8 inputText)
case parsed of
Left e -> IO.hPutStrLn IO.stderr e
Right x -> Text.hPutStr output (Pretty.prettyNinja (void x))
runOptions :: Options -> IO ()
runOptions opts = do
let pathH :: IO.IOMode -> Path -> IO IO.Handle
pathH mode p = IO.openFile (Lens.view pathString p) mode
let inputH, outputH :: Maybe Path -> IO IO.Handle
inputH = maybe (pure IO.stdin) (pathH IO.ReadMode)
outputH = maybe (pure IO.stdout) (pathH IO.WriteMode)
let pairH :: Maybe Path -> Maybe Path -> IO (IO.Handle, IO.Handle)
pairH i o = (,) <$> inputH i <*> outputH o
let closeH :: (IO.Handle, IO.Handle) -> IO ()
closeH (i, o) = IO.hClose i >> IO.hClose o >> pure ()
case opts of
(Process i o mr) -> pairH i o >>= \p -> processNinja i p mr >> closeH p
(Pretty i o c) -> pairH i o >>= \p -> prettyNinja i p c >> closeH p
--------------------------------------------------------------------------------
main :: IO ()
main = do
parseOptions >>= runOptions
--------------------------------------------------------------------------------