packages feed

language-ninja (empty) → 0.1.0

raw patch · 48 files changed

+10818/−0 lines, 48 filesdep +QuickCheckdep +aesondep +aeson-prettybuild-type:Customsetup-changed

Dependencies added: QuickCheck, aeson, aeson-pretty, base, bytestring, cabal-doctest, containers, deepseq, doctest, flow, ghc, haddock-api, haddock-library, hashable, intern, language-ninja, lens, megaparsec, monad-mock, mtl, optparse-generic, quickcheck-instances, smallcheck, system-filepath, tasty, tasty-html, tasty-hunit, tasty-lens, tasty-quickcheck, tasty-smallcheck, template-haskell, text, transformers, turtle, unordered-containers, versions

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# CHANGELOG++## Version 0.1.0++This is the first release of `language-ninja`!
+ LICENSE.md view
@@ -0,0 +1,194 @@+Apache License+==============++_Version 2.0, January 2004_+_&lt;<http://www.apache.org/licenses/>&gt;_++### Terms and Conditions for use, reproduction, and distribution++#### 1. Definitions++“License” shall mean the terms and conditions for use, reproduction, and+distribution as defined by Sections 1 through 9 of this document.++“Licensor” shall mean the copyright owner or entity authorized by the copyright+owner that is granting the License.++“Legal Entity” shall mean the union of the acting entity and all other entities+that control, are controlled by, or are under common control with that entity.+For the purposes of this definition, “control” means **(i)** the power, direct+or indirect, to cause the direction or management of such entity, whether by+contract or otherwise, or **(ii)** ownership of fifty percent (50%) or more of+the outstanding shares, or **(iii)** beneficial ownership of such entity.++“You” (or “Your”) shall mean an individual or Legal Entity exercising+permissions granted by this License.++“Source” form shall mean the preferred form for making modifications, including+but not limited to software source code, documentation source, and configuration+files.++“Object” form shall mean any form resulting from mechanical transformation or+translation of a Source form, including but not limited to compiled object code,+generated documentation, and conversions to other media types.++“Work” shall mean the work of authorship, whether in Source or Object form, made+available under the License, as indicated by a copyright notice that is included+in or attached to the work (an example is provided in the Appendix below).++“Derivative Works” shall mean any work, whether in Source or Object form, that+is based on (or derived from) the Work and for which the editorial revisions,+annotations, elaborations, or other modifications represent, as a whole, an+original work of authorship. For the purposes of this License, Derivative Works+shall not include works that remain separable from, or merely link (or bind by+name) to the interfaces of, the Work and Derivative Works thereof.++“Contribution” shall mean any work of authorship, including the original version+of the Work and any modifications or additions to that Work or Derivative Works+thereof, that is intentionally submitted to Licensor for inclusion in the Work+by the copyright owner or by an individual or Legal Entity authorized to submit+on behalf of the copyright owner. For the purposes of this definition,+“submitted” means any form of electronic, verbal, or written communication sent+to the Licensor or its representatives, including but not limited to+communication on electronic mailing lists, source code control systems, and+issue tracking systems that are managed by, or on behalf of, the Licensor for+the purpose of discussing and improving the Work, but excluding communication+that is conspicuously marked or otherwise designated in writing by the copyright+owner as “Not a Contribution.”++“Contributor” shall mean Licensor and any individual or Legal Entity on behalf+of whom a Contribution has been received by Licensor and subsequently+incorporated within the Work.++#### 2. Grant of Copyright License++Subject to the terms and conditions of this License, each Contributor hereby+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,+irrevocable copyright license to reproduce, prepare Derivative Works of,+publicly display, publicly perform, sublicense, and distribute the Work and such+Derivative Works in Source or Object form.++#### 3. Grant of Patent License++Subject to the terms and conditions of this License, each Contributor hereby+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,+irrevocable (except as stated in this section) patent license to make, have+made, use, offer to sell, sell, import, and otherwise transfer the Work, where+such license applies only to those patent claims licensable by such Contributor+that are necessarily infringed by their Contribution(s) alone or by combination+of their Contribution(s) with the Work to which such Contribution(s) was+submitted. If You institute patent litigation against any entity (including a+cross-claim or counterclaim in a lawsuit) alleging that the Work or a+Contribution incorporated within the Work constitutes direct or contributory+patent infringement, then any patent licenses granted to You under this License+for that Work shall terminate as of the date such litigation is filed.++#### 4. Redistribution++You may reproduce and distribute copies of the Work or Derivative Works thereof+in any medium, with or without modifications, and in Source or Object form,+provided that You meet the following conditions:++* **(a)** You must give any other recipients of the Work or Derivative Works a+  copy of this License; and+* **(b)** You must cause any modified files to carry prominent notices stating+  that You changed the files; and+* **(c)** You must retain, in the Source form of any Derivative Works that You+  distribute, all copyright, patent, trademark, and attribution notices from the+  Source form of the Work, excluding those notices that do not pertain to any+  part of the Derivative Works; and+* **(d)** If the Work includes a “NOTICE” text file as part of its distribution,+  then any Derivative Works that You distribute must include a readable copy of+  the attribution notices contained within such NOTICE file, excluding those+  notices that do not pertain to any part of the Derivative Works, in at least+  one of the following places: within a NOTICE text file distributed as part of+  the Derivative Works; within the Source form or documentation, if provided+  along with the Derivative Works; or, within a display generated by the+  Derivative Works, if and wherever such third-party notices normally appear.+  The contents of the NOTICE file are for informational purposes only and do not+  modify the License. You may add Your own attribution notices within Derivative+  Works that You distribute, alongside or as an addendum to the NOTICE text from+  the Work, provided that such additional attribution notices cannot be+  construed as modifying the License.++You may add Your own copyright statement to Your modifications and may provide+additional or different license terms and conditions for use, reproduction, or+distribution of Your modifications, or for any such Derivative Works as a whole,+provided Your use, reproduction, and distribution of the Work otherwise complies+with the conditions stated in this License.++#### 5. Submission of Contributions++Unless You explicitly state otherwise, any Contribution intentionally submitted+for inclusion in the Work by You to the Licensor shall be under the terms and+conditions of this License, without any additional terms or conditions.+Notwithstanding the above, nothing herein shall supersede or modify the terms of+any separate license agreement you may have executed with Licensor regarding+such Contributions.++#### 6. Trademarks++This License does not grant permission to use the trade names, trademarks,+service marks, or product names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the NOTICE file.++#### 7. Disclaimer of Warranty++Unless required by applicable law or agreed to in writing, Licensor provides the+Work (and each Contributor provides its Contributions) on an “AS IS” BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied,+including, without limitation, any warranties or conditions of TITLE,+NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are+solely responsible for determining the appropriateness of using or+redistributing the Work and assume any risks associated with Your exercise of+permissions under this License.++#### 8. Limitation of Liability++In no event and under no legal theory, whether in tort (including negligence),+contract, or otherwise, unless required by applicable law (such as deliberate+and grossly negligent acts) or agreed to in writing, shall any Contributor be+liable to You for damages, including any direct, indirect, special, incidental,+or consequential damages of any character arising as a result of this License or+out of the use or inability to use the Work (including but not limited to+damages for loss of goodwill, work stoppage, computer failure or malfunction, or+any and all other commercial damages or losses), even if such Contributor has+been advised of the possibility of such damages.++#### 9. Accepting Warranty or Additional Liability++While redistributing the Work or Derivative Works thereof, You may choose to+offer, and charge a fee for, acceptance of support, warranty, indemnity, or+other liability obligations and/or rights consistent with this License. However,+in accepting such obligations, You may act only on Your own behalf and on Your+sole responsibility, not on behalf of any other Contributor, and only if You+agree to indemnify, defend, and hold each Contributor harmless for any liability+incurred by, or claims asserted against, such Contributor by reason of your+accepting any such warranty or additional liability.++_END OF TERMS AND CONDITIONS_++### APPENDIX: How to apply the Apache License to your work++To apply the Apache License to your work, attach the following boilerplate+notice, with the fields enclosed by brackets `[]` replaced with your own+identifying information. (Don't include the brackets!) The text should be+enclosed in the appropriate comment syntax for the file format. We also+recommend that a file or class name and description of purpose be included on+the same “printed page” as the copyright notice for easier identification within+third-party archives.++    Copyright [yyyy] [name of copyright owner]++    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.
+ README.md view
@@ -0,0 +1,80 @@+# `language-ninja`++[![Hackage][hackage-badge]][hackage-link]+[![Stackage][stackage-badge]][stackage-link]+[![License][license-badge]][license-link]++`language-ninja` is a Haskell library for parsing, pretty-printing, and+compiling the [Ninja build language](https://ninja-build.org).++## Motivation++`language-ninja` was written as a part of Awake Security's efforts in creating+incremental build infrastructure for the Nix package manager, and in particular+for Haskell packages. This library is the basis for a tool, [ninja2nix][], that,+given a Ninja file, will output a JSON file containing information that a Nix+function can use to compute a derivation representing an incremental build+using one derivation per build edge in the parsed Ninja build graph.++In conjunction with an as-of-yet unwritten tool, [cabal2ninja][], that will+generate a Ninja file based on information from `cabal` and `ghc -M`, we will+have incremental builds for any Haskell package that uses a default `Setup.hs`+file.++Using Ninja as an intermediate representation has advantages here, since it+means that [ninja2nix][] could be useful for building other projects that use+a build system that can output Ninja, like the Linux kernel (with `kninja`),+Chromium, any CMake project, any Bazel project, or some Make-based projects+(with `kati`).++## Parsing++Originally, `language-ninja` used the Ninja lexer/parser from Neil Mitchell's+`shake` project. However, we now use a `megaparsec`-based lexer and a highly+modified version of the old parser. There is still work to be done on improving+the diagnostic data and pretty-printability of the AST from this parser.+In my view, it is very important that a parser output an AST that can be+pretty-printed exactly to same sequence of bytes that were in the parsed file,+as this makes tests and diagnostics much easier to write.++## Pretty-printing++Currently there is a rudimentary pretty-printer in `Language.Ninja.Pretty`.+It simply outputs text such that if that text is parsed and the parsed data+is pretty-printed again, the resulting text will be identical to the original+text (this is tested on a variety of Ninja files in the test suite).++## Compiling++The `Ninja` type from `Language.Ninja.IR.Ninja` contains precisely the data+that must be acted on dynamically in a Ninja. In converting from the parsed+AST to the intermediate representation using `Language.Ninja.Compile.compile`,+you are eliminating all statically-dischargeable language features in Ninja,+like variables. It also "monomorphizes" Ninja `rule`s, since rule-level `$out`+references are a kind of parametric polymorphism. This IR is thus far more+suitable for processing than the original parsed AST.++## Miscellaneous++The `staging` branch is used for active development; i.e.: force pushes may+happen on `staging` but will not happen on `master`.++To build this, I recommend installing the Nix package manager and running+`nix-build release.nix -A language-ninja`.++[hackage-badge]:+    https://img.shields.io/hackage/v/language-ninja.svg?label=Hackage+[hackage-link]:+    https://hackage.haskell.org/package/language-ninja+[stackage-badge]:+    https://www.stackage.org/package/language-ninja/badge/lts?label=Stackage+[stackage-link]:+    https://www.stackage.org/package/language-ninja+[license-badge]:+    https://img.shields.io/badge/License-Apache%202.0-blue.svg+[license-link]:+    https://spdx.org/licenses/Apache-2.0.html+[ninja2nix]:+    https://github.com/awakesecurity/ninja2nix+[cabal2ninja]:+    https://github.com/awakesecurity/cabal2ninja
+ Setup.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE CPP #-}++module Main (main) where++#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif++#if MIN_VERSION_cabal_doctest(1,0,0)++import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests"++#else++#ifdef MIN_VERSION_Cabal+-- If the macro is defined, we have new cabal-install,+-- but for some reason we don't have cabal-doctest in package-db+--+-- Probably we are running cabal sdist, when otherwise using new-build+-- workflow+#warning You are configuring this package without cabal-doctest installed. \+         The doctests test-suite will not work as a result. \+         To fix this, install cabal-doctest before configuring.+#endif++import Distribution.Simple++main :: IO ()+main = defaultMain++#endif
+ executables/ninja-compile/Main.hs view
@@ -0,0 +1,181 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: executables/ninja-compile/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     (runExcept, runExceptT)++import           Options.Generic          ((:::), type (<?>))+import qualified Options.Generic          as Opt++import           GHC.Generics             (Generic)++import           Data.Char                (toLower)+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 Language.Ninja.Compile   as Compile+import qualified Language.Ninja.Errors    as Errors+import           Language.Ninja.Misc.Path (Path, pathFP, pathString)+import qualified Language.Ninja.Parser    as Parser++import qualified Data.Aeson               as Aeson+import qualified Data.Aeson.Encode.Pretty as Aeson++import qualified System.IO                as IO++import           Flow                     ((.>))++--------------------------------------------------------------------------------++version :: Text+version = Text.pack (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 OptionInput+  = Maybe Path <?> "Read the given FILEPATH as a Ninja file."+type OptionOutput+  = Maybe Path <?> "Output to the given FILEPATH instead of /dev/stdout."+type OptionMachineReadable+  = Bool       <?> "Should the output be fully machine-readable?"++data Options' w+  = Options'+    { _optionsInput           :: (w ::: OptionInput)+    , _optionsOutput          :: (w ::: OptionOutput)+    , _optionsMachineReadable :: (w ::: OptionMachineReadable) }+  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 ("ninja-compile 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 throwMRPE :: Errors.ParseError -> IO ()+      throwMRPE = Aeson.toJSON .> encodeJ .> Text.hPutStrLn output++  let throwMRCE :: Errors.CompileError -> IO ()+      throwMRCE = 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 throwMRPE e+               else throwIO e+    Right x -> case runExcept (Compile.compile x) of+                 Left  e -> if machineReadable+                            then throwMRCE e+                            else throwIO e+                 Right c -> Text.hPutStr output (encodeJ (Aeson.toJSON c))++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+    (Options' i o mr) -> pairH i o >>= \p -> processNinja i p mr >> closeH p++--------------------------------------------------------------------------------++main :: IO ()+main = do+  parseOptions >>= runOptions++--------------------------------------------------------------------------------
+ executables/ninja-lex/Main.hs view
@@ -0,0 +1,192 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: executables/ninja-lex/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     (runExcept)++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.Errors    as Errors+import qualified Language.Ninja.Lexer     as Lexer+import           Language.Ninja.Misc.Path (Path, pathFP, pathString)+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-lex 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++  case runExcept (Lexer.lexTextWithPath inputPath inputText) 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 [Lexer.Lexeme Lexer.Ann]+      parsed = Aeson.eitherDecode (LText.encodeUtf8 inputText)+  case parsed of+    Left  e -> IO.hPutStrLn IO.stderr e+    Right x -> Text.hPutStr output (Pretty.prettyLexemes (map 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++--------------------------------------------------------------------------------
+ executables/ninja-parse/Main.hs view
@@ -0,0 +1,198 @@+-- -*- 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++--------------------------------------------------------------------------------
+ language-ninja.cabal view
@@ -0,0 +1,315 @@+--------------------------------------------------------------------------------++name:                     language-ninja+version:                  0.1.0+stability:                Experimental+build-type:               Custom+cabal-version:            >= 1.10+category:                 Language+copyright:                Copyright 2017 Awake Security+author:                   Awake Security+maintainer:               opensource@awakesecurity.com+license:                  Apache-2.0+license-file:             LICENSE.md+homepage:                 https://github.com/awakesecurity/language-ninja+bug-reports:              https://github.com/awakesecurity/language-ninja/issues+category:                 Build, Language+synopsis:                 A library for dealing with the Ninja build language.+description:              A Haskell library for parsing, pretty-printing, and+                          compiling the Ninja build language.+                          The best place to start reading this documentation is+                          the "Language.Ninja" module.+extra-source-files:       README.md+                        , CHANGELOG.md+tested-with:              GHC == 8.0.1+                          +--------------------------------------------------------------------------------++source-repository head+    type:                 git+    branch:               master+    location:             https://github.com/awakesecurity/language-ninja.git++source-repository this+    type:                 git+    tag:                  release-0.1.0+    location:             https://github.com/awakesecurity/language-ninja.git++--------------------------------------------------------------------------------++custom-setup+    setup-depends:        base                        >= 4.8   && < 5.0+                        , Cabal                       >= 1.24  && < 1.25+                        , cabal-doctest               >= 1.0.2 && < 1.1++--------------------------------------------------------------------------------++library+    hs-source-dirs:       library+    build-depends:        base                        >= 4.8   && < 5.0+                        , aeson                       >= 1.0   && < 1.3+                        , bytestring                  >= 0.10  && < 0.11+                        , containers                  >= 0.5   && < 0.6+                        , deepseq                     >= 1.4   && < 1.5+                        , flow                        >= 1.0   && < 1.1+                        , hashable                    >= 1.2   && < 1.3+                        , intern                      >= 0.9   && < 0.10+                        , megaparsec                  >= 5.2   && < 5.3+                        , mtl                         >= 2.2   && < 2.3+                        , lens                        >= 4.15  && < 4.16+                        , QuickCheck                  >= 2.9   && < 2.10+                        , quickcheck-instances        >= 0.3   && < 0.4+                        , smallcheck                  >= 1.1   && < 1.2+                        , system-filepath             >= 0.4   && < 0.5+                        , text                        >= 1.2   && < 1.3+                        , transformers                >= 0.5   && < 0.6+                        , unordered-containers        >= 0.2   && < 0.3+                        , versions                    >= 3.1.1 && < 3.2+    exposed-modules:      Language.Ninja+                        , Language.Ninja.Compile+                        , Language.Ninja.Lexer+                        , Language.Ninja.Lexer.Types+                        , Language.Ninja.Parser+                        , Language.Ninja.Pretty+                        , Language.Ninja.Tutorial+                        , Language.Ninja.AST+                        , Language.Ninja.AST.Build+                        , Language.Ninja.AST.Deps+                        , Language.Ninja.AST.Env+                        , Language.Ninja.AST.Expr+                        , Language.Ninja.AST.Ninja+                        , Language.Ninja.AST.Rule+                        , Language.Ninja.IR+                        , Language.Ninja.IR.Build+                        , Language.Ninja.IR.Meta+                        , Language.Ninja.IR.Ninja+                        , Language.Ninja.IR.Pool+                        , Language.Ninja.IR.Rule+                        , Language.Ninja.IR.Target+                        , Language.Ninja.Errors+                        , Language.Ninja.Errors.Compile+                        , Language.Ninja.Errors.Parser+                        , Language.Ninja.Mock+                        , Language.Ninja.Mock.ReadFile+                        , Language.Ninja.Misc+                        , Language.Ninja.Misc.Annotated+                        , Language.Ninja.Misc.Command+                        , Language.Ninja.Misc.IText+                        , Language.Ninja.Misc.Located+                        , Language.Ninja.Misc.Path+                        , Language.Ninja.Misc.Positive+    default-language:     Haskell2010+    other-extensions:     ConstraintKinds+                        , DeriveDataTypeable+                        , DeriveFoldable+                        , DeriveFunctor+                        , DeriveGeneric+                        , DeriveTraversable+                        , FlexibleContexts+                        , FlexibleInstances+                        , GADTs+                        , GeneralizedNewtypeDeriving+                        , InstanceSigs+                        , KindSignatures+                        , LambdaCase+                        , MultiParamTypeClasses+                        , OverloadedStrings+                        , RankNTypes+                        , RecordWildCards+                        , ScopedTypeVariables+                        , UndecidableInstances+    ghc-options:          -Wcompat -Weverything+                          -fno-warn-unsafe+                          -fno-warn-safe+                          -fno-warn-implicit-prelude+                          -fno-warn-unused-do-bind+                          -fno-warn-missed-specialisations+                          -fno-warn-all-missed-specialisations+                          -g++--------------------------------------------------------------------------------++test-suite tests+    type:                 exitcode-stdio-1.0+    hs-source-dirs:       tests+    main-is:              Tests.hs+    other-modules:        Tests.Lint+                        , Tests.Mock+                        , Tests.Orphans+                        , Tests.ReferenceLexer+                        , Tests.ReferenceLexer.Str0+    build-depends:        language-ninja+                        , base                        >= 4.8   && < 5.0+                        , aeson                       >= 1.0   && < 1.3+                        , bytestring                  >= 0.10  && < 0.11+                        , containers                  >= 0.5   && < 0.6+                        , flow                        >= 1.0   && < 1.1+                        , ghc                         >= 7.4   && < 8.4+                        , haddock-api                 >= 2.17  && < 2.18+                        , haddock-library             >= 1.4   && < 1.5+                        , hashable                    >= 1.2   && < 1.3+                        , lens                        >= 4.15  && < 4.16+                        , monad-mock                  >= 0.1   && < 0.2+                        , mtl                         >= 2.2   && < 2.3+                        , QuickCheck                  >= 2.9   && < 2.10+                        , quickcheck-instances        >= 0.3   && < 0.4+                        , smallcheck                  >= 1.1   && < 1.2+                        , system-filepath             >= 0.4   && < 0.5+                        , tasty                       >= 0.11  && < 0.12+                        , tasty-html                  >= 0.4   && < 0.5+                        , tasty-hunit                 >= 0.9   && < 0.10+                        , tasty-lens                  >= 0.3   && < 0.4+                        , tasty-quickcheck            >= 0.8   && < 0.9+                        , tasty-smallcheck            >= 0.8   && < 0.9+                        , text                        >= 1.2   && < 1.3+                        , transformers                >= 0.5   && < 0.6+                        , turtle                      >= 1.3   && < 1.4+                        , unordered-containers        >= 0.2   && < 0.3+                        , versions                    >= 3.1.1 && < 3.2+    default-language:     Haskell2010+    other-extensions:     FlexibleContexts+                        , FlexibleInstances+                        , GADTs+                        , LambdaCase+                        , MultiParamTypeClasses+                        , OverloadedStrings+                        , PatternGuards+                        , RankNTypes+                        , RecordWildCards+                        , ScopedTypeVariables+                        , StandaloneDeriving+                        , TypeApplications+                        , TypeFamilies+                        , UndecidableInstances+                        , ViewPatterns+    ghc-options:          -Wcompat -Weverything+                          -fno-warn-unsafe+                          -fno-warn-safe+                          -fno-warn-implicit-prelude+                          -fno-warn-unused-do-bind+                          -fno-warn-missed-specialisations+                          -fno-warn-all-missed-specialisations+                          -g -threaded++--------------------------------------------------------------------------------++test-suite doctests+    type:                 exitcode-stdio-1.0+    hs-source-dirs:       tests+    main-is:              DocTests.hs+    build-depends:        base                        >= 4.8   && < 5.0+                        , doctest                     >= 0.11  && < 0.12+                        , QuickCheck                  >= 2.9   && < 2.10+                        , template-haskell            >= 2.11  && < 2.12+                        -- TODO: this shouldn't need to be here+                        -- remove this once https://git.io/vQp2m is merged+                        , cabal-doctest               >= 1.0.2 && < 1.1+    default-language:     Haskell2010+    ghc-options:          -Wall -threaded++--------------------------------------------------------------------------------++executable ninja-lex+    hs-source-dirs:       executables/ninja-lex+    main-is:              Main.hs+    build-depends:        language-ninja+                        , base                        >= 4.8   && < 5.0+                        , aeson                       >= 1.0   && < 1.3+                        , aeson-pretty                >= 0.8   && < 0.9+                        , flow                        >= 1.0   && < 1.1+                        , lens                        >= 4.15  && < 4.16+                        , mtl                         >= 2.2   && < 2.3+                        , optparse-generic            >= 1.1   && < 1.2+                        -- , prettyprinter               >= 1.1   && < 1.2+                        -- , prettyprinter-ansi-terminal >= 1.1   && < 1.2+                        , text                        >= 1.2   && < 1.3+                        , transformers                >= 0.5   && < 0.6+    default-language:     Haskell2010+    other-extensions:     DataKinds+                        , DeriveGeneric+                        , ExplicitNamespaces+                        , FlexibleInstances+                        , GADTSyntax+                        , OverloadedStrings+                        , StandaloneDeriving+                        , TypeOperators+    ghc-options:          -Wcompat -Weverything+                          -fno-warn-unsafe+                          -fno-warn-safe+                          -fno-warn-implicit-prelude+                          -fno-warn-unused-do-bind+                          -fno-warn-missed-specialisations+                          -fno-warn-all-missed-specialisations+                          -g -threaded++--------------------------------------------------------------------------------++executable ninja-parse+    hs-source-dirs:       executables/ninja-parse+    main-is:              Main.hs+    build-depends:        language-ninja+                        , base                        >= 4.8   && < 5.0+                        , aeson                       >= 1.0   && < 1.3+                        , aeson-pretty                >= 0.8   && < 0.9+                        , flow                        >= 1.0   && < 1.1+                        , lens                        >= 4.15  && < 4.16+                        , mtl                         >= 2.2   && < 2.3+                        , optparse-generic            >= 1.1   && < 1.2+                        -- , prettyprinter               >= 1.1   && < 1.2+                        -- , prettyprinter-ansi-terminal >= 1.1   && < 1.2+                        , text                        >= 1.2   && < 1.3+                        , transformers                >= 0.5   && < 0.6+    default-language:     Haskell2010+    other-extensions:     DataKinds+                        , DeriveGeneric+                        , ExplicitNamespaces+                        , FlexibleInstances+                        , GADTSyntax+                        , OverloadedStrings+                        , StandaloneDeriving+                        , TypeOperators+    ghc-options:          -Wcompat -Weverything+                          -fno-warn-unsafe+                          -fno-warn-safe+                          -fno-warn-implicit-prelude+                          -fno-warn-unused-do-bind+                          -fno-warn-missed-specialisations+                          -fno-warn-all-missed-specialisations+                          -g -threaded++--------------------------------------------------------------------------------++executable ninja-compile+    hs-source-dirs:       executables/ninja-compile+    main-is:              Main.hs+    build-depends:        language-ninja+                        , base                        >= 4.8   && < 5.0+                        , aeson                       >= 1.0   && < 1.3+                        , aeson-pretty                >= 0.8   && < 0.9+                        , flow                        >= 1.0   && < 1.1+                        , lens                        >= 4.15  && < 4.16+                        , mtl                         >= 2.2   && < 2.3+                        , optparse-generic            >= 1.1   && < 1.2+                        -- , prettyprinter               >= 1.1   && < 1.2+                        -- , prettyprinter-ansi-terminal >= 1.1   && < 1.2+                        , text                        >= 1.2   && < 1.3+                        , transformers                >= 0.5   && < 0.6+    default-language:     Haskell2010+    other-extensions:     DataKinds+                        , DeriveGeneric+                        , ExplicitNamespaces+                        , FlexibleInstances+                        , GADTSyntax+                        , OverloadedStrings+                        , StandaloneDeriving+                        , TypeOperators+    ghc-options:          -Wcompat -Weverything+                          -fno-warn-unsafe+                          -fno-warn-safe+                          -fno-warn-implicit-prelude+                          -fno-warn-unused-do-bind+                          -fno-warn-missed-specialisations+                          -fno-warn-all-missed-specialisations+                          -g -threaded++--------------------------------------------------------------------------------
+ library/Language/Ninja.hs view
@@ -0,0 +1,76 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja.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-missing-import-lists #-}++-- |+--   Module      : Language.Ninja+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Tools for parsing, pretty-printing, and compiling the Ninja build language.+--+--   This module re-exports some of the modules under the "Language.Ninja"+--   namespace for convenience.+--+--   Take a look at "Language.Ninja.Tutorial" for a tutorial on how to use this+--   library. If you just want to dive in, I recommend reading these modules+--   in the following order:+--+--   1. Skim "Language.Ninja.Misc", "Language.Ninja.Mock",+--      and "Language.Ninja.Errors" for familiarity with types and values+--      that are used all over this library.+--   2. Check out "Language.Ninja.Lexer" and then "Language.Ninja.Parser" to+--      get an idea for what is possible with the lexer/parser API.+--   3. Read "Language.Ninja.AST" to understand what the parsed AST looks like.+--   4. Read "Language.Ninja.Compile" to see what the AST-to-IR compiler does.+--   5. Read "Language.Ninja.IR" to understand what the compiled IR looks like.+--   6. Read "Language.Ninja.Pretty" to see what the pretty-printer is capable+--      of (spoiler: not very much).+--+--   If you are not already well-versed in the Ninja build language, it is also+--   probably worth reading the Ninja+--   <https://ninja-build.org/manual.html manual>.+--+--   When importing from this library, I recommend the following style:+--+--   > import qualified Language.Ninja     as Ninja+--   > import qualified Language.Ninja.AST as Ninja.AST+--   > import qualified Language.Ninja.IR  as Ninja.IR+--+--   Happy hacking!+--+--   @since 0.1.0+module Language.Ninja+  ( module Language.Ninja.Compile+  , module Language.Ninja.Lexer+  , module Language.Ninja.Parser+  , module Language.Ninja.Pretty+  , module Language.Ninja.Misc+  , module Language.Ninja.Mock+  ) where++import           Language.Ninja.Compile+import           Language.Ninja.Lexer+import           Language.Ninja.Misc+import           Language.Ninja.Mock+import           Language.Ninja.Parser+import           Language.Ninja.Pretty
+ library/Language/Ninja/AST.hs view
@@ -0,0 +1,80 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/AST.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-missing-import-lists #-}++-- |+--   Module      : Language.Ninja.AST+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   The Ninja build language after parsing.+--+--   This module re-exports all of the modules under the "Language.Ninja.AST"+--   namespace for convenience.+--+--   It is recommended that you import it with the following style:+--+--   > import qualified Language.Ninja.AST as AST+--+--   @since 0.1.0+module Language.Ninja.AST+  ( -- * "Language.Ninja.AST.Ninja"+    AST.Ninja, AST.makeNinja+  , AST.ninjaRules+  , AST.ninjaSingles+  , AST.ninjaMultiples+  , AST.ninjaPhonys+  , AST.ninjaDefaults+  , AST.ninjaPools+  , AST.ninjaSpecials++    -- * "Language.Ninja.AST.Build"+  , AST.Build, AST.makeBuild+  , AST.buildRule, AST.buildEnv, AST.buildDeps, AST.buildBind++    -- * "Language.Ninja.AST.Deps"+  , AST.Deps, AST.makeDeps+  , AST.depsNormal, AST.depsImplicit, AST.depsOrderOnly++    -- * "Language.Ninja.AST.Rule"+  , AST.Rule, AST.makeRule+  , AST.ruleBind++    -- * "Language.Ninja.AST.Expr"+  , AST.Expr (..)+  , AST._Exprs, AST._Lit, AST._Var+  , AST.askVar, AST.askExpr, AST.addBind, AST.addBinds+  , AST.normalizeExpr++    -- * "Language.Ninja.AST.Env"+  , AST.Env+  , AST.makeEnv, AST.fromEnv, AST.addEnv, AST.askEnv, AST.scopeEnv+  ) where++import qualified Language.Ninja.AST.Build as AST+import qualified Language.Ninja.AST.Deps  as AST+import qualified Language.Ninja.AST.Env   as AST+import qualified Language.Ninja.AST.Expr  as AST+import qualified Language.Ninja.AST.Ninja as AST+import qualified Language.Ninja.AST.Rule  as AST++--------------------------------------------------------------------------------
+ library/Language/Ninja/AST/Build.hs view
@@ -0,0 +1,220 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/AST/Build.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.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.AST.Build+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains a type representing a @build@ declaration in the+--   parsed Ninja AST, along with any supporting or related types.+--+--   @since 0.1.0+module Language.Ninja.AST.Build+  ( -- * @Build@+    Build, makeBuild+  , buildRule, buildEnv, buildDeps, buildBind+  , BuildConstraint+  ) where++import qualified Control.Lens              as Lens++import           Flow                      ((.>), (|>))++import           Data.HashMap.Strict       (HashMap)+import           Data.Text                 (Text)++import           Control.DeepSeq           (NFData)+import           Data.Hashable             (Hashable)+import           GHC.Generics              (Generic)++import qualified Test.QuickCheck           as QC+import           Test.QuickCheck.Instances ()++import qualified Test.SmallCheck.Series    as SC++import           GHC.Exts                  (Constraint)++import           Data.Aeson                ((.:), (.=))+import qualified Data.Aeson                as Aeson++import qualified Language.Ninja.AST.Deps   as AST+import qualified Language.Ninja.AST.Env    as AST+import qualified Language.Ninja.Misc       as Misc++--------------------------------------------------------------------------------++-- | A parsed Ninja @build@ declaration.+--+--   @since 0.1.0+data Build ann+  = MkBuild+    { _buildAnn  :: !ann+    , _buildRule :: !Text+    , _buildEnv  :: !(AST.Env Text Text)+    , _buildDeps :: !(AST.Deps ann)+    , _buildBind :: !(HashMap Text Text)+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Construct a 'Build' with all default values.+--+--   @since 0.1.0+{-# INLINE makeBuild #-}+makeBuild :: (Monoid ann)+          => Text+          -- ^ The rule name+          -> AST.Env Text Text+          -- ^ The environment+          -> Build ann+makeBuild rule env = MkBuild+                     { _buildAnn  = mempty+                     , _buildRule = rule+                     , _buildEnv  = env+                     , _buildDeps = AST.makeDeps+                     , _buildBind = mempty+                     }++-- | A lens into the rule name associated with a 'Build'.+--+--   @since 0.1.0+{-# INLINE buildRule #-}+buildRule :: Lens.Lens' (Build ann) Text+buildRule = Lens.lens _buildRule+            $ \(MkBuild {..}) x -> MkBuild { _buildRule = x, .. }++-- | A lens into the environment associated with a 'Build'.+--+--   @since 0.1.0+{-# INLINE buildEnv #-}+buildEnv :: Lens.Lens' (Build ann) (AST.Env Text Text)+buildEnv = Lens.lens _buildEnv+           $ \(MkBuild {..}) x -> MkBuild { _buildEnv = x, .. }++-- | A lens into the dependencies associated with a 'Build'.+--+--   @since 0.1.0+{-# INLINE buildDeps #-}+buildDeps :: Lens.Lens' (Build ann) (AST.Deps ann)+buildDeps = Lens.lens _buildDeps+            $ \(MkBuild {..}) x -> MkBuild { _buildDeps = x, .. }++-- | A lens into the bindings associated with a 'Build'.+--+--   @since 0.1.0+{-# INLINE buildBind #-}+buildBind :: Lens.Lens' (Build ann) (HashMap Text Text)+buildBind = Lens.lens _buildBind+            $ \(MkBuild {..}) x -> MkBuild { _buildBind = x, .. }++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated Build where+  annotation' f = Lens.lens (helper .> fst) (helper .> snd)+    where+      helper (MkBuild {..})+        = ( _buildAnn+          , \x -> MkBuild { _buildAnn = x, _buildDeps = f <$> _buildDeps, .. } )++-- | Converts to @{ann: …, rule: …, env: …, deps: …, bind: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (Build ann) where+  toJSON (MkBuild {..})+    = [ "ann"  .= _buildAnn+      , "rule" .= _buildRule+      , "env"  .= _buildEnv+      , "deps" .= _buildDeps+      , "bind" .= _buildBind+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (Build ann) where+  parseJSON = (Aeson.withObject "Build" $ \o -> do+                  _buildAnn  <- (o .: "ann")  >>= pure+                  _buildRule <- (o .: "rule") >>= pure+                  _buildEnv  <- (o .: "env")  >>= pure+                  _buildDeps <- (o .: "deps") >>= pure+                  _buildBind <- (o .: "bind") >>= pure+                  pure (MkBuild {..}))++-- | Reasonable 'QC.Arbitrary' instance for 'Build'.+--+--   @since 0.1.0+instance (QC.Arbitrary ann) => QC.Arbitrary (Build ann) where+  arbitrary = MkBuild+              <$> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (Build ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (Build ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, BuildConstraint (SC.Serial m) ann+         ) => SC.Serial m (Build ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, BuildConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (Build ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for a 'Build'.+--+--   @since 0.1.0+type BuildConstraint (c :: * -> Constraint) (ann :: *)+  = ( AST.DepsConstraint c ann+    , c Text+    , c (HashMap Text Text)+    , c (AST.Maps Text Text)+    , c ann+    )++--------------------------------------------------------------------------------
+ library/Language/Ninja/AST/Deps.hs view
@@ -0,0 +1,195 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/AST/Deps.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.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.AST.Deps+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains a type representing the dependencies of a @build@+--   declaration in the parsed Ninja AST, along with any supporting or+--   related types.+--+--   @since 0.1.0+module Language.Ninja.AST.Deps+  ( -- * @Deps@+    Deps, makeDeps+  , depsNormal, depsImplicit, depsOrderOnly+  , DepsConstraint+  ) where++import qualified Control.Lens              as Lens++import           Flow                      ((|>))++import           Data.HashSet              (HashSet)+import           Data.Text                 (Text)++import           Control.DeepSeq           (NFData)+import           Data.Hashable             (Hashable)+import           GHC.Generics              (Generic)++import qualified Test.QuickCheck           as QC+import           Test.QuickCheck.Instances ()++import qualified Test.SmallCheck.Series    as SC++import           GHC.Exts                  (Constraint)++import           Data.Aeson                ((.:), (.=))+import qualified Data.Aeson                as Aeson++import qualified Language.Ninja.Misc       as Misc++--------------------------------------------------------------------------------++-- | A set of Ninja build dependencies.+--+--   @since 0.1.0+data Deps ann+  = MkDeps+    { _depsAnn       :: !ann+    , _depsNormal    :: !(HashSet Text)+    , _depsImplicit  :: !(HashSet Text)+    , _depsOrderOnly :: !(HashSet Text)+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Construct a 'Deps' with all default values+--+--   @since 0.1.0+{-# INLINE makeDeps #-}+makeDeps :: (Monoid ann) => Deps ann+makeDeps = MkDeps+            { _depsAnn       = mempty+            , _depsNormal    = mempty+            , _depsImplicit  = mempty+            , _depsOrderOnly = mempty+            }++-- | A lens into the set of normal dependencies in a 'Deps'.+--+--   @since 0.1.0+{-# INLINE depsNormal #-}+depsNormal :: Lens.Lens' (Deps ann) (HashSet Text)+depsNormal = Lens.lens _depsNormal+             $ \(MkDeps {..}) x -> MkDeps { _depsNormal = x, .. }++-- | A lens into the set of implicit dependencies in a 'Deps'.+--+--   @since 0.1.0+{-# INLINE depsImplicit #-}+depsImplicit :: Lens.Lens' (Deps ann) (HashSet Text)+depsImplicit = Lens.lens _depsImplicit+               $ \(MkDeps {..}) x -> MkDeps { _depsImplicit = x, .. }++-- | A lens into the set of order-only dependencies in a 'Deps'.+--+--   @since 0.1.0+{-# INLINE depsOrderOnly #-}+depsOrderOnly :: Lens.Lens' (Deps ann) (HashSet Text)+depsOrderOnly = Lens.lens _depsOrderOnly+                $ \(MkDeps {..}) x -> MkDeps { _depsOrderOnly = x, .. }++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated Deps where+  annotation' _ = Lens.lens _depsAnn+                  $ \(MkDeps {..}) x -> MkDeps { _depsAnn = x, .. }++-- | Converts to @{ann: …, normal: …, implicit: …, order-only: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (Deps ann) where+  toJSON (MkDeps {..})+    = [ "ann"        .= _depsAnn+      , "normal"     .= _depsNormal+      , "implicit"   .= _depsImplicit+      , "order-only" .= _depsOrderOnly+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (Deps ann) where+  parseJSON = (Aeson.withObject "Deps" $ \o -> do+                  _depsAnn       <- (o .: "ann")        >>= pure+                  _depsNormal    <- (o .: "normal")     >>= pure+                  _depsImplicit  <- (o .: "implicit")   >>= pure+                  _depsOrderOnly <- (o .: "order-only") >>= pure+                  pure (MkDeps {..}))++-- | Reasonable 'QC.Arbitrary' instance for 'Deps'.+--+--   @since 0.1.0+instance (QC.Arbitrary ann) => QC.Arbitrary (Deps ann) where+  arbitrary = MkDeps+              <$> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (Deps ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (Deps ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, DepsConstraint (SC.Serial m) ann+         ) => SC.Serial m (Deps ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, DepsConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (Deps ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for a 'Ninja'.+--+--   @since 0.1.0+type DepsConstraint (c :: * -> Constraint) (ann :: *)+  = ( c (HashSet Text)+    , c ann+    )++--------------------------------------------------------------------------------
+ library/Language/Ninja/AST/Env.hs view
@@ -0,0 +1,224 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/AST/Env.hs+--+-- License:+--     Copyright Neil Mitchell  2011-2017.+--     Copyright Awake Security 2017+--     All rights reserved.+--+--     Redistribution and use in source and binary forms, with or without+--     modification, are permitted provided that the following conditions are+--     met:+--+--         * Redistributions of source code must retain the above copyright+--           notice, this list of conditions and the following disclaimer.+--+--         * Redistributions in binary form must reproduce the above+--           copyright notice, this list of conditions and the following+--           disclaimer in the documentation and/or other materials provided+--           with the distribution.+--+--         * Neither the name of Neil Mitchell nor the names of other+--           contributors may be used to endorse or promote products derived+--           from this software without specific prior written permission.+--+--     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+--     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+--     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+--     A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+--     OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+--     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+--     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+--     DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+--     THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+--     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+--     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.AST.Env+--   Copyright   : Copyright 2011-2017 Neil Mitchell+--   License     : BSD3+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains a type representing a Ninja-style environment along+--   with any supporting or related types.+--+--   @since 0.1.0+module Language.Ninja.AST.Env+  ( Env, makeEnv, fromEnv, headEnv, tailEnv+  , scopeEnv, addEnv, askEnv+  , EnvConstraint+  , Key, Maps+  ) where++import           Control.Applicative       ((<|>))+import           Control.Monad             ((>=>))++import qualified Control.Lens              as Lens++import           Data.Monoid               (Endo (Endo, appEndo))++import           Data.List.NonEmpty        (NonEmpty ((:|)))+import qualified Data.List.NonEmpty        as NE++import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as HM++import           Control.DeepSeq           (NFData)+import           Data.Hashable             (Hashable)+import           GHC.Generics              (Generic)++import qualified Test.QuickCheck           as QC+import           Test.QuickCheck.Instances ()++import qualified Test.SmallCheck.Series    as SC++import           GHC.Exts                  (Constraint)++import qualified Data.Aeson                as Aeson++import           Flow                      ((.>), (|>))++--------------------------------------------------------------------------------++-- | A Ninja-style environment, basically a nonempty list of hash tables.+--+--   @since 0.1.0+newtype Env k v+  = MkEnv+    { _fromEnv :: Maps k v+    }+  deriving (Eq, Show, Generic)++-- | Construct an empty environment.+--+--   @since 0.1.0+{-# INLINE makeEnv #-}+makeEnv :: Env k v+makeEnv = MkEnv (HM.empty :| [])++-- | An isomorphism between an 'Env' and a nonempty list of 'HashMap's.+--+--   @since 0.1.0+{-# INLINE fromEnv #-}+fromEnv :: Lens.Iso' (Env k v) (Maps k v)+fromEnv = Lens.iso _fromEnv MkEnv++-- | Get the first 'HashMap' in the underlying nonempty list.+--+--   @since 0.1.0+{-# INLINEABLE headEnv #-}+headEnv :: Env k v -> HashMap k v+headEnv (MkEnv (m :| _)) = m++-- | If the remainder of the underlying nonempty list is nonempty, return+--   the remainder after 'Env' wrapping. Otherwise, return 'Nothing'.+--+--   @since 0.1.0+{-# INLINEABLE tailEnv #-}+tailEnv :: Env k v -> Maybe (Env k v)+tailEnv (MkEnv (_ :| e)) = MkEnv <$> NE.nonEmpty e++-- | Push a new 'Env' onto the stack.+--+--   @since 0.1.0+{-# INLINEABLE scopeEnv #-}+scopeEnv :: Env k v -> Env k v+scopeEnv e = MkEnv (NE.cons HM.empty (_fromEnv e))++-- | Add the given key and value to the given 'Env'.+--+--   @since 0.1.0+{-# INLINEABLE addEnv #-}+addEnv :: (Key k) => k -> v -> Env k v -> Env k v+addEnv k v (MkEnv (m :| rest)) = MkEnv (HM.insert k v m :| rest)++-- | Look up the given key in the given 'Env'.+--+--   @since 0.1.0+{-# INLINEABLE askEnv #-}+askEnv :: (Key k) => Env k v -> k -> Maybe v+askEnv env k = HM.lookup k (headEnv env)+               <|> (tailEnv env >>= (`askEnv` k))++-- | Converts to a (nonempty) array of JSON objects.+--+--   @since 0.1.0+instance (Aeson.ToJSONKey k, Aeson.ToJSON v) => Aeson.ToJSON (Env k v) where+  toJSON = _fromEnv .> NE.toList .> Aeson.toJSON++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance ( Key k, Aeson.FromJSONKey k, Aeson.FromJSON v+         ) => Aeson.FromJSON (Env k v) where+  parseJSON = Aeson.parseJSON+              >=> NE.nonEmpty+              .>  maybe (fail "Env list was empty!") pure+              .>  fmap MkEnv++-- | Reasonable 'QC.Arbitrary' instance for 'Env'.+--+--   @since 0.1.0+instance ( Key k, QC.Arbitrary k, QC.Arbitrary v+         ) => QC.Arbitrary (Env k v) where+  arbitrary = QC.arbitrary+              |> fmap (map (uncurry addEnv .> Endo)+                       .> mconcat+                       .> (\e -> appEndo e makeEnv))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable k, Hashable v) => Hashable (Env k v)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData k, NFData v) => NFData (Env k v)++-- | Uses the underlying 'Maps' instance.+--+--   @since 0.1.0+instance ( Monad m, EnvConstraint (SC.Serial m) k v+         ) => SC.Serial m (Env k v) where+  series = SC.series |> fmap MkEnv++-- | Uses the underlying 'Maps' instance.+--+--   @since 0.1.0+instance ( Monad m, EnvConstraint (SC.CoSerial m) k v+         ) => SC.CoSerial m (Env k v) where+  coseries = SC.coseries .> fmap (\f -> _fromEnv .> f)++-- | The set of constraints required for a given constraint to be automatically+--   computed for an 'Env'.+--+--   @since 0.1.0+type EnvConstraint (c :: * -> Constraint) (k :: *) (v :: *)+  = (Key k, c k, c v, c (Maps k v))++--------------------------------------------------------------------------------++-- | A constraint alias for @('Eq' k, 'Hashable' k)@.+--+--   @since 0.1.0+type Key k = (Eq k, Hashable k)++-- | A 'NE.NonEmpty' list of 'HashMap's.+--+--   @since 0.1.0+type Maps k v = NE.NonEmpty (HashMap k v)++--------------------------------------------------------------------------------
+ library/Language/Ninja/AST/Expr.hs view
@@ -0,0 +1,297 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/AST/Expr.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.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.AST.Expr+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains a type representing a string that potentially contains+--   variable references in the parsed Ninja AST, along with any supporting or+--   related types.+--+--   @since 0.1.0+module Language.Ninja.AST.Expr+  ( -- * @Expr@+    Expr (..)+  , _Exprs, _Lit, _Var+  , askVar, askExpr, addBind, addBinds+  , normalizeExpr+  , ExprConstraint+  ) where++import           Control.Arrow             (second)++import qualified Control.Lens              as Lens++import           Data.Foldable             (asum)+import           Data.Maybe                (fromMaybe)+import           Data.Monoid               (Endo (Endo, appEndo), (<>))++import           Flow                      ((.>), (|>))++import           Data.Text                 (Text)+import qualified Data.Text                 as Text++import           Control.DeepSeq           (NFData)+import           Data.Data                 (Data)+import           Data.Hashable             (Hashable)+import           GHC.Generics              (Generic)++import qualified Test.QuickCheck           as QC+import           Test.QuickCheck.Instances ()++import qualified Test.SmallCheck.Series    as SC++import           GHC.Exts                  (Constraint)++import           Data.Aeson                ((.:), (.=))+import qualified Data.Aeson                as Aeson++import qualified Language.Ninja.AST.Env    as AST+import qualified Language.Ninja.Misc       as Misc++--------------------------------------------------------------------------------++-- | An expression containing variable references in the Ninja language.+--+--   @since 0.1.0+data Expr ann+  = -- | Sequencing of expressions.+    --+    --   @since 0.1.0+    Exprs !ann ![Expr ann]+  | -- | A literal string.+    --+    --   @since 0.1.0+    Lit   !ann !Text+  | -- | A variable reference.+    --+    --   @since 0.1.0+    Var   !ann !Text+  deriving (Eq, Show, Generic, Data, Functor, Foldable, Traversable)++-- | A prism for the 'Exprs' constructor.+--+--   @since 0.1.0+{-# INLINE _Exprs #-}+_Exprs :: Lens.Prism' (Expr ann) (ann, [Expr ann])+_Exprs = Lens.prism' (uncurry Exprs)+         $ \case (Exprs ann es) -> Just (ann, es)+                 _              -> Nothing++-- | A prism for the 'Lit' constructor.+--+--   @since 0.1.0+{-# INLINE _Lit #-}+_Lit :: Lens.Prism' (Expr ann) (ann, Text)+_Lit = Lens.prism' (uncurry Lit)+       $ \case (Lit ann text) -> Just (ann, text)+               _              -> Nothing++-- | A prism for the 'Var' constructor.+--+--   @since 0.1.0+{-# INLINE _Var #-}+_Var :: Lens.Prism' (Expr ann) (ann, Text)+_Var = Lens.prism' (uncurry Var)+       $ \case (Var ann name) -> Just (ann, name)+               _              -> Nothing++-- | Evaluate the given 'Expr' in the given context (@'Env' 'Text' 'Text'@).+--+--   @since 0.1.0+askExpr :: AST.Env Text Text -> Expr ann -> Text+askExpr e (Exprs _ xs) = Text.concat (map (askExpr e) xs)+askExpr _ (Lit   _ x)  = x+askExpr e (Var   _ x)  = askVar e x++-- | Look up the given variable in the given context, returning the empty string+--   if the variable was not found.+--+--   @since 0.1.0+askVar :: AST.Env Text Text -> Text -> Text+askVar e x = fromMaybe Text.empty (AST.askEnv e x)++-- | Add a binding with the given name ('Text') and value ('Expr') to the+--   given context.+--+--   @since 0.1.0+addBind :: Text -> Expr ann -> AST.Env Text Text -> AST.Env Text Text+addBind k v e = AST.addEnv k (askExpr e v) e++-- | Add bindings from a list. Note that this function evaluates all the+--   right-hand-sides first, and then adds them all to the environment.+--+--   For example:+--+--   >>> :set -XOverloadedStrings+--   >>> let binds = [("x", Lit () "5"), ("y", Var () "x")]+--   >>> AST.headEnv (addBinds binds AST.makeEnv)+--   fromList [("x","5"),("y","")]+--+--   @since 0.1.0+addBinds :: [(Text, Expr ann)] -> AST.Env Text Text -> AST.Env Text Text+addBinds bs e = map (second (askExpr e) .> uncurry AST.addEnv .> Endo) bs+                |> mconcat+                |> (\endo -> appEndo endo e)++-- | Normalize an 'Expr' by recursively flattening any 'Exprs' nodes, removing+--   empty 'Lit' nodes, combining adjacent 'Lit' nodes, and pulling out the+--   interior of the top-level 'Exprs' node if it has only one subnode.+--+--   The number of 'Exprs' nodes in the output is guaranteed to be 0 or 1.+--+--   If it is 0, then there is exactly one node of any type in the output.+--+--   The output is thus isomorphic to @(Maybe ann, [(ann, Either Text Text)])@,+--   where the @Maybe ann@ represents the annotation of the top-level 'Exprs'+--   node if it exists.+--+--   @since 0.1.0+normalizeExpr :: forall ann. (Monoid ann) => Expr ann -> Expr ann+normalizeExpr = flatten .> removeEmpty .> combineAdj .> listToExpr+  where+    flatten :: Expr ann -> [Expr ann]+    flatten (Exprs _ es) = concatMap flatten es+    flatten owise        = [owise]++    removeEmpty :: [Expr ann] -> [Expr ann]+    removeEmpty []                = []+    removeEmpty (Lit _ "" : rest) = removeEmpty rest+    removeEmpty (owise    : rest) = owise : removeEmpty rest++    combineAdj :: [Expr ann] -> [Expr ann]+    combineAdj = (\case+      []                               -> []+      (Lit annX x : Lit annY y : rest) -> (Lit (annX <> annY) (x <> y))+                                          |> (\e -> combineAdj (e : rest))+      (owise                   : rest) -> owise : combineAdj rest)++    listToExpr :: [Expr ann] -> Expr ann+    listToExpr [e] = e+    listToExpr es  = Exprs (mconcat (map (Lens.view Misc.annotation) es)) es++-- | The usual definition for 'Lens.Plated'.+--+--   @since 0.1.0+instance (Data ann) => Lens.Plated (Expr ann)++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated Expr where+  annotation' f = Lens.lens (helper .> fst) (helper .> snd)+    where+      helper (Exprs ann   es) = (ann, \x -> Exprs x (map (fmap f) es))+      helper (Lit   ann text) = (ann, \x -> Lit   x text)+      helper (Var   ann name) = (ann, \x -> Var   x name)++-- | Converts 'Exprs' to @{ann: …, exprs: […]}@, 'Lit' to @{ann: …, lit: […]}@,+--   and 'Var' to @{ann: …, var: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (Expr ann) where+  toJSON (Exprs ann   es) = Aeson.object ["ann" .= ann, "exprs" .= es]+  toJSON (Lit   ann text) = Aeson.object ["ann" .= ann, "lit"   .= text]+  toJSON (Var   ann name) = Aeson.object ["ann" .= ann, "var"   .= name]++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (Expr ann) where+  parseJSON = Aeson.withObject "Expr" $ \o -> do+    ann <- o .: "ann"+    asum [ Exprs ann <$> (o .: "exprs")+         , Lit   ann <$> (o .: "lit")+         , Var   ann <$> (o .: "var")+         ]++-- | Reasonable 'QC.Arbitrary' instance for 'Expr'.+--+--   @since 0.1.0+instance forall ann. (QC.Arbitrary ann) => QC.Arbitrary (Expr ann) where+  arbitrary = QC.sized go+    where+      go :: Int -> QC.Gen (Expr ann)+      go n | n <= 0 = [ litG (QC.resize litLength QC.arbitrary)+                      , varG (QC.resize varLength QC.arbitrary)+                      ] |> QC.oneof+      go n          = [ go 0+                      , do width <- (`mod` maxWidth) <$> QC.arbitrary+                           let subtree = go (n `div` lossRate)+                           Exprs <$> QC.arbitrary <*> QC.vectorOf width subtree+                      ] |> QC.oneof++      litG, varG :: QC.Gen Text -> QC.Gen (Expr ann)+      litG g = Lit <$> QC.arbitrary <*> g+      varG g = Var <$> QC.arbitrary <*> g++      litLength, varLength, lossRate, maxWidth :: Int+      litLength = 10+      varLength = 10+      maxWidth  = 5+      lossRate  = 2++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (Expr ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (Expr ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, ExprConstraint (SC.Serial m) ann+         ) => SC.Serial m (Expr ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, ExprConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (Expr ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for a 'Expr'.+--+--   @since 0.1.0+type ExprConstraint (c :: * -> Constraint) (ann :: *) = (c Text, c ann)++--------------------------------------------------------------------------------
+ library/Language/Ninja/AST/Ninja.hs view
@@ -0,0 +1,309 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/AST/Ninja.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.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.AST.Ninja+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains a type representing a parsed Ninja file AST, along+--   with any supporting or related types.+--+--   @since 0.1.0+module Language.Ninja.AST.Ninja+  ( -- * @Ninja@+    Ninja, makeNinja+  , ninjaRules+  , ninjaSingles+  , ninjaMultiples+  , ninjaPhonys+  , ninjaDefaults+  , ninjaPools+  , ninjaSpecials+  , NinjaConstraint+  , Outputs, Output+  ) where++import           Control.Monad             ((>=>))++import qualified Control.Lens              as Lens++import           Flow                      ((.>), (|>))++import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as HM++import           Data.HashSet              (HashSet)++import           Data.Text                 (Text)++import           Control.DeepSeq           (NFData)+import           Data.Hashable             (Hashable)+import           GHC.Generics              (Generic)++import qualified Test.QuickCheck           as QC+import           Test.QuickCheck.Instances ()++import qualified Test.SmallCheck.Series    as SC++import           GHC.Exts                  (Constraint)++import           Data.Aeson                ((.:), (.=))+import qualified Data.Aeson                as Aeson+import qualified Data.Aeson.Types          as Aeson++import qualified Language.Ninja.AST.Build  as AST+import qualified Language.Ninja.AST.Rule   as AST+import qualified Language.Ninja.Misc       as Misc++--------------------------------------------------------------------------------++-- | A parsed Ninja file.+--+--   @since 0.1.0+data Ninja ann+  = MkNinja+    { _ninjaAnn       :: !ann+    , _ninjaRules     :: !(HashMap Text (AST.Rule ann))+    , _ninjaSingles   :: !(HashMap Output  (AST.Build ann))+    , _ninjaMultiples :: !(HashMap Outputs (AST.Build ann))+    , _ninjaPhonys    :: !(HashMap Text (HashSet Text))+    , _ninjaDefaults  :: !(HashSet Text)+    , _ninjaPools     :: !(HashMap Text Int)+    , _ninjaSpecials  :: !(HashMap Text Text)+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Construct a 'Ninja' with all default values+--+--   @since 0.1.0+{-# INLINE makeNinja #-}+makeNinja :: (Monoid ann) => Ninja ann+makeNinja = MkNinja+            { _ninjaAnn       = mempty+            , _ninjaRules     = mempty+            , _ninjaSingles   = mempty+            , _ninjaMultiples = mempty+            , _ninjaPhonys    = mempty+            , _ninjaDefaults  = mempty+            , _ninjaPools     = mempty+            , _ninjaSpecials  = mempty+            }++-- | The rules defined in a parsed Ninja file.+--+--   @since 0.1.0+{-# INLINE ninjaRules #-}+ninjaRules :: Lens.Lens' (Ninja ann) (HashMap Text (AST.Rule ann))+ninjaRules = Lens.lens _ninjaRules+             $ \(MkNinja {..}) x -> MkNinja { _ninjaRules = x, .. }++-- | The set of @build@ declarations with precisely one output.+--+--   @since 0.1.0+{-# INLINE ninjaSingles #-}+ninjaSingles :: Lens.Lens' (Ninja ann) (HashMap Text (AST.Build ann))+ninjaSingles = Lens.lens _ninjaSingles+               $ \(MkNinja {..}) x -> MkNinja { _ninjaSingles = x, .. }++-- | The set of @build@ declarations with two or more outputs.+--+--   @since 0.1.0+{-# INLINE ninjaMultiples #-}+ninjaMultiples :: Lens.Lens' (Ninja ann) (HashMap Outputs (AST.Build ann))+ninjaMultiples = Lens.lens _ninjaMultiples+                 $ \(MkNinja {..}) x -> MkNinja { _ninjaMultiples = x, .. }++-- | The set of phony @build@ declarations.+--+--   @since 0.1.0+{-# INLINE ninjaPhonys #-}+ninjaPhonys :: Lens.Lens' (Ninja ann) (HashMap Text (HashSet Text))+ninjaPhonys = Lens.lens _ninjaPhonys+              $ \(MkNinja {..}) x -> MkNinja { _ninjaPhonys = x, .. }++-- | The set of default targets.+--+--   @since 0.1.0+{-# INLINE ninjaDefaults #-}+ninjaDefaults :: Lens.Lens' (Ninja ann) (HashSet Text)+ninjaDefaults = Lens.lens _ninjaDefaults+                $ \(MkNinja {..}) x -> MkNinja { _ninjaDefaults = x, .. }++-- | A mapping from pool names to pool depth integers.+--+--   @since 0.1.0+{-# INLINE ninjaPools #-}+ninjaPools :: Lens.Lens' (Ninja ann) (HashMap Text Int)+ninjaPools = Lens.lens _ninjaPools+             $ \(MkNinja {..}) x -> MkNinja { _ninjaPools = x, .. }++-- | A map from "special" top-level variables to their values.+--+--   @since 0.1.0+{-# INLINE ninjaSpecials #-}+ninjaSpecials :: Lens.Lens' (Ninja ann) (HashMap Text Text)+ninjaSpecials = Lens.lens _ninjaSpecials+                $ \(MkNinja {..}) x -> MkNinja { _ninjaSpecials = x, .. }++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated Ninja where+  annotation' f = Lens.lens _ninjaAnn+                  $ \(MkNinja {..}) x ->+                      MkNinja+                      { _ninjaAnn       = x+                      , _ninjaRules     = HM.map (fmap f) _ninjaRules+                      , _ninjaSingles   = HM.map (fmap f) _ninjaSingles+                      , _ninjaMultiples = HM.map (fmap f) _ninjaMultiples+                      , .. }++-- | Converts to+--   @{ann: …, rules: …, singles: …, multiples: …, phonys: …, defaults: …,+--     pools: …, specials: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (Ninja ann) where+  toJSON (MkNinja {..})+    = [ "ann"       .= _ninjaAnn+      , "rules"     .= _ninjaRules+      , "singles"   .= _ninjaSingles+      , "multiples" .= fixMultiples _ninjaMultiples+      , "phonys"    .= _ninjaPhonys+      , "defaults"  .= _ninjaDefaults+      , "pools"     .= _ninjaPools+      , "specials"  .= _ninjaSpecials+      ] |> Aeson.object+    where+      fixMultiples :: (Aeson.ToJSON ann)+                   => HashMap Outputs (AST.Build ann) -> Aeson.Value+      fixMultiples = HM.toList .> map (uncurry printPair) .> Aeson.toJSON++      printPair :: (Aeson.ToJSON ann) => Outputs -> AST.Build ann -> Aeson.Value+      printPair outputs build+        = Aeson.object ["outputs" .= outputs, "build" .= build]++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (Ninja ann) where+  parseJSON = (Aeson.withObject "Ninja" $ \o -> do+                  _ninjaAnn       <- (o .: "ann")       >>= pure+                  _ninjaRules     <- (o .: "rules")     >>= pure+                  _ninjaSingles   <- (o .: "singles")   >>= pure+                  _ninjaMultiples <- (o .: "multiples") >>= fixMultiples+                  _ninjaPhonys    <- (o .: "phonys")    >>= pure+                  _ninjaDefaults  <- (o .: "defaults")  >>= pure+                  _ninjaPools     <- (o .: "pools")     >>= pure+                  _ninjaSpecials  <- (o .: "specials")  >>= pure+                  pure (MkNinja {..}))+    where+      fixMultiples :: (Aeson.FromJSON ann)+                   => Aeson.Value+                   -> Aeson.Parser (HashMap Outputs (AST.Build ann))+      fixMultiples = Aeson.parseJSON+                     >=> mapM parsePair+                     >=> (HM.fromList .> pure)++      parsePair :: (Aeson.FromJSON ann)+                => Aeson.Value+                -> Aeson.Parser (Outputs, AST.Build ann)+      parsePair = (Aeson.withObject "Ninja.multiples" $ \o -> do+                      outputs <- (o .: "outputs") >>= pure+                      build   <- (o .: "build")   >>= pure+                      pure (outputs, build))++-- | Reasonable 'QC.Arbitrary' instance for 'Ninja'.+--+--   @since 0.1.0+instance (QC.Arbitrary ann) => QC.Arbitrary (Ninja ann) where+  arbitrary = MkNinja+              <$> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary+              <*> QC.arbitrary++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (Ninja ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (Ninja ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, NinjaConstraint (SC.Serial m) ann+         ) => SC.Serial m (Ninja ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, NinjaConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (Ninja ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for a 'Ninja'.+--+--   @since 0.1.0+type NinjaConstraint (c :: * -> Constraint) (ann :: *)+  = ( AST.BuildConstraint c ann+    , c (HashMap (HashSet Text) (AST.Build ann))+    , c (HashMap Text (HashSet Text))+    , c (HashMap Text (AST.Rule ann))+    , c (HashMap Text (AST.Build ann))+    , c (HashMap Text Int)+    , c ann+    )++-- | A type representing the set of outputs for a @build@ declaration with+--   multiple outputs.+--+--   @since 0.1.0+type Outputs = HashSet Output++-- | A type representing an output of a @build@ declaration.+--+--   @since 0.1.0+type Output = Text++--------------------------------------------------------------------------------
+ library/Language/Ninja/AST/Rule.hs view
@@ -0,0 +1,171 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/AST/Rule.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.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.AST.Rule+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains a type representing a @rule@ declaration in the+--   parsed Ninja AST, along with any supporting or related types.+--+--   @since 0.1.0+module Language.Ninja.AST.Rule+  ( Rule, makeRule+  , ruleBind+  , RuleConstraint+  ) where++import qualified Control.Lens              as Lens++import           Flow                      ((|>))++import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as HM++import           Data.Text                 (Text)++import           Control.DeepSeq           (NFData)+import           Data.Hashable             (Hashable)+import           GHC.Generics              (Generic)++import qualified Test.QuickCheck           as QC+import           Test.QuickCheck.Instances ()++import qualified Test.SmallCheck.Series    as SC++import           GHC.Exts                  (Constraint)++import           Data.Aeson                ((.:), (.=))+import qualified Data.Aeson                as Aeson++import qualified Language.Ninja.AST.Expr   as AST+import qualified Language.Ninja.Misc       as Misc++--------------------------------------------------------------------------------++-- | A parsed Ninja @rule@ declaration.+--+--   @since 0.1.0+data Rule ann+  = MkRule+    { _ruleAnn  :: !ann+    , _ruleBind :: !(HashMap Text (AST.Expr ann))+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Construct a 'Rule' with all default values+--+--   @since 0.1.0+{-# INLINE makeRule #-}+makeRule :: (Monoid ann) => Rule ann+makeRule = MkRule+           { _ruleAnn  = mempty+           , _ruleBind = mempty+           }++-- | The set of bindings in scope during the execution of this rule.+--+--   @since 0.1.0+{-# INLINE ruleBind #-}+ruleBind :: Lens.Lens' (Rule ann) (HashMap Text (AST.Expr ann))+ruleBind = Lens.lens _ruleBind+           $ \(MkRule {..}) x -> MkRule { _ruleBind = x, .. }++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated Rule where+  annotation' f = Lens.lens _ruleAnn+                  $ \(MkRule {..}) x ->+                      MkRule { _ruleAnn = x+                             , _ruleBind = HM.map (fmap f) _ruleBind+                             , .. }++-- | Converts to @{ann: …, bind: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (Rule ann) where+  toJSON (MkRule {..})+    = [ "ann"  .= _ruleAnn+      , "bind" .= _ruleBind+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (Rule ann) where+  parseJSON = (Aeson.withObject "Rule" $ \o -> do+                  _ruleAnn  <- (o .: "ann")  >>= pure+                  _ruleBind <- (o .: "bind") >>= pure+                  pure (MkRule {..}))++-- | Reasonable 'QC.Arbitrary' instance for 'Rule'.+--+--   @since 0.1.0+instance (QC.Arbitrary ann) => QC.Arbitrary (Rule ann) where+  arbitrary = MkRule <$> QC.arbitrary <*> QC.arbitrary++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (Rule ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (Rule ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, RuleConstraint (SC.Serial m) ann+         ) => SC.Serial m (Rule ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, RuleConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (Rule ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for a 'Rule'.+--+--   @since 0.1.0+type RuleConstraint (c :: * -> Constraint) (ann :: *)+  = ( c (HashMap Text (AST.Expr ann))+    , c ann+    )++--------------------------------------------------------------------------------
+ library/Language/Ninja/Compile.hs view
@@ -0,0 +1,308 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Compile.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.++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}++-- |+--   Module      : Language.Ninja.Compile+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Compile a parsed Ninja file into an intermediate representation.+--+--   @since 0.1.0+module Language.Ninja.Compile+  ( compile+  ) where++import           Control.Applicative       ((<|>))+import           Control.Arrow             (first)++import qualified Control.Lens              as Lens++import           Control.Monad.Error.Class (MonadError)++import           Data.Char                 (isSpace)+import           Data.Maybe                (fromMaybe, isJust)+import           Data.Monoid               (Endo (Endo, appEndo), (<>))++import           Data.Text                 (Text)+import qualified Data.Text                 as Text++import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as HM++import           Data.HashSet              (HashSet)+import qualified Data.HashSet              as HS++import           Flow                      ((.>), (|>))++import           Data.Hashable             (Hashable)++import qualified Data.Versions             as Ver++import qualified Language.Ninja.AST        as AST+import qualified Language.Ninja.Errors     as Errors+import qualified Language.Ninja.IR         as IR+import qualified Language.Ninja.Misc       as Misc++-------------------------------------------------------------------------------++-- | Compile an parsed Ninja file into a intermediate representation.+--+--   @since 0.1.0+compile :: forall m ann. (MonadError Errors.CompileError m)+        => AST.Ninja ann -> m IR.Ninja+compile ast = result+  where+    result :: m IR.Ninja+    result = do+      meta     <- metaM+      builds   <- buildsM+      phonys   <- phonysM+      defaults <- defaultsM+      pools    <- poolsM++      IR.makeNinja+        |> Lens.set IR.ninjaMeta     meta+        |> Lens.set IR.ninjaBuilds   builds+        |> Lens.set IR.ninjaPhonys   phonys+        |> Lens.set IR.ninjaDefaults defaults+        |> Lens.set IR.ninjaPools    pools+        |> pure++    metaM :: m IR.Meta+    metaM = do+      let getSpecial :: Text -> Maybe Text+          getSpecial name = HM.lookup name (Lens.view AST.ninjaSpecials ast)++      let parseVersion :: Text -> m Ver.Version+          parseVersion = Ver.version+                         .> either Errors.throwVersionParseFailure pure++      reqversion <- getSpecial "ninja_required_version"+                    |> fmap parseVersion+                    |> sequenceA+      builddir   <- getSpecial "builddir"+                    |> fmap Misc.makePath+                    |> pure++      IR.makeMeta+        |> Lens.set IR.metaReqVersion reqversion+        |> Lens.set IR.metaBuildDir   builddir+        |> pure++    buildsM :: m (HashSet IR.Build)+    buildsM = (multiplesAST <> onHM (first HS.singleton) singlesAST)+              |> HM.toList |> mapM compileBuild |> fmap HS.fromList++    phonysM :: m (HashMap IR.Target (HashSet IR.Target))+    phonysM = HM.toList phonysAST |> mapM compilePhony |> fmap HM.fromList++    defaultsM :: m (HashSet IR.Target)+    defaultsM = HS.toList defaultsAST |> mapM compileDefault |> fmap HS.fromList++    poolsM :: m (HashSet IR.Pool)+    poolsM = HM.toList poolsAST |> mapM compilePool |> fmap HS.fromList++    compileBuild :: (HashSet Text, AST.Build ann) -> m IR.Build+    compileBuild (outputs, buildAST) = do+      let depsAST       = Lens.view AST.buildDeps buildAST+      let normalDeps    = HS.toList (Lens.view AST.depsNormal    depsAST)+      let implicitDeps  = HS.toList (Lens.view AST.depsImplicit  depsAST)+      let orderOnlyDeps = HS.toList (Lens.view AST.depsOrderOnly depsAST)++      outs <- HS.toList outputs |> mapM compileOutput |> fmap HS.fromList+      rule <- compileRule (outs, buildAST)+      deps <- let compileDep ty dep = compileDependency (dep, ty)+              in (\n i o -> HS.fromList (n <> i <> o))+                 <$> mapM (compileDep IR.NormalDependency)    normalDeps+                 <*> mapM (compileDep IR.NormalDependency)    implicitDeps+                 <*> mapM (compileDep IR.OrderOnlyDependency) orderOnlyDeps++      IR.makeBuild rule+        |> Lens.set IR.buildOuts outs+        |> Lens.set IR.buildDeps deps+        |> pure++    compilePhony :: (Text, HashSet Text)+                  -> m (IR.Target, HashSet IR.Target)+    compilePhony (name, deps) = do+      ename <- compileTarget name+      edeps <- HS.fromList <$> mapM compileTarget (HS.toList deps)+      pure (ename, edeps)++    compileDefault :: Text -> m IR.Target+    compileDefault = compileTarget++    compilePool :: (Text, Int) -> m IR.Pool+    compilePool pair = case pair of+      ("console", 1) -> pure IR.makePoolConsole+      ("console", d) -> Errors.throwInvalidPoolDepth d+      ("",        _) -> Errors.throwEmptyPoolName+      (name,      d) -> do dp <- Misc.makePositive d+                                 |> maybe (Errors.throwInvalidPoolDepth d) pure+                           pure (IR.makePoolCustom name dp)++    compileRule :: (HashSet IR.Output, AST.Build ann) -> m IR.Rule+    compileRule (outputs, buildAST) = do+      (name, ruleAST) <- lookupRule buildAST++      let orLookupError :: Text -> Maybe a -> m a+          orLookupError var = maybe (Errors.throwRuleLookupFailure var) pure++      let env = computeRuleEnv (outputs, buildAST) ruleAST++      let lookupBind :: Text -> m (Maybe Text)+          lookupBind = AST.askEnv env .> pure++      let lookupBind_ :: Text -> m Text+          lookupBind_ var = lookupBind var >>= orLookupError var++      command      <- lookupBind_ "command" >>= compileCommand+      description  <- lookupBind "description"+      pool         <- let buildBind = Lens.view AST.buildBind buildAST+                      in (HM.lookup "pool" buildBind <|> AST.askEnv env "pool")+                         |> fromMaybe ""+                         |> IR.parsePoolName+                         |> pure+      depfile      <- lookupBind "depfile"+                      |> fmap (fmap Misc.makePath)+      specialDeps  <- let lookupPrefix = lookupBind "msvc_deps_prefix"+                      in ((,) <$> lookupBind "deps" <*> lookupPrefix)+                         >>= compileSpecialDeps+      generator    <- isJust <$> lookupBind "generator"+      restat       <- isJust <$> lookupBind "restat"+      responseFile <- do ma <- lookupBind "rspfile"+                         mb <- lookupBind "rspfile_content"+                         pure ((,) <$> ma <*> mb)+                           >>= fmap compileResponseFile .> sequenceA++      IR.makeRule name command+        |> Lens.set IR.ruleDescription  description+        |> Lens.set IR.rulePool         pool+        |> Lens.set IR.ruleDepfile      depfile+        |> Lens.set IR.ruleSpecialDeps  specialDeps+        |> Lens.set IR.ruleGenerator    generator+        |> Lens.set IR.ruleRestat       restat+        |> Lens.set IR.ruleResponseFile responseFile+        |> pure++    compileSpecialDeps :: (Maybe Text, Maybe Text) -> m (Maybe IR.SpecialDeps)+    compileSpecialDeps = (\case (Nothing,     _) -> pure Nothing+                                (Just "gcc",  m) -> goGCC  m+                                (Just "msvc", m) -> goMSVC m+                                (Just d,      _) -> Errors.throwUnknownDeps d)+      where+        goGCC, goMSVC :: Maybe Text -> m (Maybe IR.SpecialDeps)+        goGCC  (Just _) = Errors.throwUnexpectedMSVCPrefix "gcc"+        goGCC  Nothing  = pure (Just IR.makeSpecialDepsGCC)+        goMSVC (Just m) = pure (Just (IR.makeSpecialDepsMSVC m))+        goMSVC Nothing  = pure (Just (IR.makeSpecialDepsMSVC defaultPrefix))++        defaultPrefix = "Note: including file: " :: Text++    compileResponseFile :: (Text, Text) -> m IR.ResponseFile+    compileResponseFile (file, content) = do+      let path = Misc.makePath file+      pure (IR.makeResponseFile path content)++    compileTarget :: Text -> m IR.Target+    compileTarget = IR.makeTarget .> pure++    compileOutput :: Text -> m IR.Output+    compileOutput name = do+      target <- compileTarget name+      pure (IR.makeOutput target)++    compileDependency :: (Text, IR.DependencyType) -> m IR.Dependency+    compileDependency (name, ty) = do+      target <- compileTarget name+      pure (IR.makeDependency target ty)++    compileCommand :: Text -> m Misc.Command+    compileCommand = Misc.makeCommand .> pure++    lookupRule :: AST.Build ann -> m (Text, AST.Rule ann)+    lookupRule buildAST = do+      let name = Lens.view AST.buildRule buildAST+      ruleAST <- HM.lookup name rulesAST+                 |> maybe (Errors.throwBuildRuleNotFound name) pure+      pure (name, ruleAST)++    computeRuleEnv :: (HashSet IR.Output, AST.Build ann)+                   -> AST.Rule ann+                   -> AST.Env Text Text+    computeRuleEnv (outs, buildAST) ruleAST = do+      let depsAST = Lens.view AST.buildDeps buildAST++      -- TODO: properly handle implicit/explicit outputs here++      let isExplicitOut :: IR.Output -> Bool+          isExplicitOut _ = True++      let explicitOuts = HS.toList outs+                         |> filter isExplicitOut+                         |> map (Lens.view (IR.outputTarget . IR.targetText))++      let explicitDeps = [ Lens.view AST.depsNormal    depsAST+                         , Lens.view AST.depsOrderOnly depsAST+                         ] |> mconcat |> HS.toList++      let composeList :: [a -> a] -> (a -> a)+          composeList = map Endo .> mconcat .> appEndo++      let quote :: Text -> Text+          quote x | Text.any isSpace x = mconcat ["\"", x, "\""]+          quote x                      = x++      let bindings = Lens.view AST.buildBind buildAST++      -- the order of adding new environment variables matters+      AST.scopeEnv (Lens.view AST.buildEnv buildAST)+        |> AST.addEnv "out"        (Text.unwords (map quote explicitOuts))+        |> AST.addEnv "in"         (Text.unwords (map quote explicitDeps))+        |> AST.addEnv "in_newline" (Text.unlines explicitDeps)+        |> composeList (map (uncurry AST.addEnv) (HM.toList bindings))+        |> AST.addBinds (HM.toList (Lens.view AST.ruleBind ruleAST))++    rulesAST     :: HashMap Text (AST.Rule ann)+    singlesAST   :: HashMap Text (AST.Build ann)+    multiplesAST :: HashMap (HashSet Text) (AST.Build ann)+    phonysAST    :: HashMap Text (HashSet Text)+    defaultsAST  :: HashSet Text+    poolsAST     :: HashMap Text Int+    rulesAST     = Lens.view AST.ninjaRules     ast+    singlesAST   = Lens.view AST.ninjaSingles   ast+    multiplesAST = Lens.view AST.ninjaMultiples ast+    phonysAST    = Lens.view AST.ninjaPhonys    ast+    defaultsAST  = Lens.view AST.ninjaDefaults  ast+    poolsAST     = Lens.view AST.ninjaPools     ast++    onHM :: (Eq k', Hashable k')+         => ((k, v) -> (k', v')) -> HashMap k v -> HashMap k' v'+    onHM f = HM.toList .> map f .> HM.fromList++--------------------------------------------------------------------------------
+ library/Language/Ninja/Errors.hs view
@@ -0,0 +1,153 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Errors.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-missing-import-lists #-}++{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+--   Module      : Language.Ninja.Errors+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module re-exports all of the modules under the "Language.Ninja.Errors"+--   namespace for convenience.+--+--   It is recommended that you import it with the following style:+--+--   > import qualified Language.Ninja.Errors as Errors+--+--   @since 0.1.0+module Language.Ninja.Errors+  ( -- * "Language.Ninja.Errors"+    NinjaError (..)+  , throwNinjaError+  , throwGenericNinjaError+  , throwNinjaParseError+  , throwNinjaCompileError++    -- * "Language.Ninja.Errors.Compile"+  , CompileError (..)+  , throwCompileError+  , throwGenericCompileError++  , CompileMetaError (..)+  , throwCompileMetaError+  , throwGenericCompileMetaError+  , throwVersionParseFailure++  , CompilePhonyError (..)+  , throwCompilePhonyError+  , throwGenericCompilePhonyError++  , CompileDefaultError (..)+  , throwCompileDefaultError+  , throwGenericCompileDefaultError++  , CompileBuildError (..)+  , throwCompileBuildError+  , throwGenericCompileBuildError+  , throwBuildRuleNotFound++  , CompileRuleError (..)+  , throwCompileRuleError+  , throwGenericCompileRuleError+  , throwRuleLookupFailure+  , throwUnknownDeps+  , throwUnexpectedMSVCPrefix++  , CompilePoolError (..)+  , throwCompilePoolError+  , throwGenericCompilePoolError+  , throwInvalidPoolDepth+  , throwEmptyPoolName++    -- * "Language.Ninja.Errors.Parser"+  , ParseError (..)+  , throwParseError+  , throwGenericParseError+  , throwLexBindingFailure+  , throwLexExpectedColon+  , throwLexUnexpectedDollar+  , throwLexUnexpectedSeparator+  , throwLexParsecError+  , throwParseBadDepthField+  , throwParseUnexpectedBinding+  ) where++import           Language.Ninja.Errors.Compile+import           Language.Ninja.Errors.Parser++import           Control.Exception             (Exception)+import           Control.Monad.Error.Class     (MonadError (..))+import           Data.Text                     (Text)+import           GHC.Generics                  (Generic)++--------------------------------------------------------------------------------++-- | This type subsumes any error that can be thrown during execution of a+--   function defined in @language-ninja@.+--+--   @since 0.1.0+data NinjaError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericNinjaError !Text+  | -- | Errors encountered during parsing.+    --+    --   @since 0.1.0+    NinjaParseError   !ParseError+  | -- | Errors encountered during compilation.+    --+    --   @since 0.1.0+    NinjaCompileError !CompileError+  deriving (Eq, Show, Generic)++instance Exception NinjaError++-- | Throw a 'NinjaError'.+--+--   @since 0.1.0+throwNinjaError :: (MonadError NinjaError m) => NinjaError -> m a+throwNinjaError = throwError++-- | Throw a generic catch-all 'NinjaError'.+--+--   @since 0.1.0+throwGenericNinjaError :: (MonadError NinjaError m) => Text -> m a+throwGenericNinjaError msg = throwNinjaError (GenericNinjaError msg)++-- | Throw a 'ParseError'.+--+--   @since 0.1.0+throwNinjaParseError :: (MonadError NinjaError m) => ParseError -> m a+throwNinjaParseError e = throwNinjaError (NinjaParseError e)++-- | Throw a 'CompileError'.+--+--   @since 0.1.0+throwNinjaCompileError :: (MonadError NinjaError m) => CompileError -> m a+throwNinjaCompileError e = throwNinjaError (NinjaCompileError e)++--------------------------------------------------------------------------------
+ library/Language/Ninja/Errors/Compile.hs view
@@ -0,0 +1,523 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Errors/Compile.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.++{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ViewPatterns          #-}++-- |+--   Module      : Language.Ninja.Errors.Compile+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Errors thrown during Ninja compilation.+--+--   @since 0.1.0+module Language.Ninja.Errors.Compile+  ( -- * @CompileError@+    CompileError (..)+  , throwCompileError, throwGenericCompileError++    -- * @CompileMetaError@+  , CompileMetaError (..)+  , throwCompileMetaError, throwGenericCompileMetaError+  , throwVersionParseFailure++    -- * @CompilePhonyError@+  , CompilePhonyError (..)+  , throwCompilePhonyError, throwGenericCompilePhonyError++    -- * @CompileDefaultError@+  , CompileDefaultError (..)+  , throwCompileDefaultError, throwGenericCompileDefaultError++    -- * @CompileBuildError@+  , CompileBuildError (..)+  , throwCompileBuildError, throwGenericCompileBuildError+  , throwBuildRuleNotFound++    -- * @CompileRuleError@+  , CompileRuleError (..)+  , throwCompileRuleError, throwGenericCompileRuleError+  , throwRuleLookupFailure+  , throwUnknownDeps+  , throwUnexpectedMSVCPrefix++    -- * @CompilePoolError@+  , CompilePoolError (..)+  , throwCompilePoolError, throwGenericCompilePoolError+  , throwInvalidPoolDepth+  , throwEmptyPoolName+  ) where++import           Control.Exception         (Exception)+import           Control.Monad.Error.Class (MonadError (throwError))+import           GHC.Generics              (Generic)++import           Data.Text                 (Text)++import           Data.Aeson                ((.=))+import qualified Data.Aeson                as Aeson++import qualified Text.Megaparsec           as M++import qualified Data.Versions             as Ver++import           Data.Foldable             (toList)++import           Flow                      ((.>), (|>))++--------------------------------------------------------------------------------++-- | The type of errors encountered during compilation.+--+--   @since 0.1.0+data CompileError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericCompileError !Text+  | -- | Errors encountered while compiling a 'Meta'.+    --+    --   @since 0.1.0+    CompileMetaError    !CompileMetaError+  | -- | Errors encountered while compiling a 'Build'.+    --+    --   @since 0.1.0+    CompileBuildError   !CompileBuildError+  | -- | Errors encountered while compiling a 'Rule'.+    --+    --   @since 0.1.0+    CompileRuleError    !CompileRuleError+  | -- | Errors encountered while compiling the phony 'HashMap'.+    --+    --   @since 0.1.0+    CompilePhonyError   !CompilePhonyError+  | -- | Errors encountered while compiling the default target 'HashSet'.+    --+    --   @since 0.1.0+    CompileDefaultError !CompileDefaultError+  | -- | Errors encountered while compiling a 'Pool'.+    --+    --   @since 0.1.0+    CompilePoolError    !CompilePoolError+  deriving (Eq, Show, Generic)++-- | Throw a 'CompileError'.+--+--   @since 0.1.0+throwCompileError :: (MonadError CompileError m) => CompileError -> m a+throwCompileError = throwError++-- | Throw a generic catch-all 'CompileError'.+--+--   @since 0.1.0+throwGenericCompileError :: (MonadError CompileError m) => Text -> m a+throwGenericCompileError msg = throwCompileError (GenericCompileError msg)++-- | Default instance.+--+--   @since 0.1.0+instance Exception CompileError++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON CompileError where+  toJSON = go+    where+      go (GenericCompileError text) = obj "generic-compile-error" text+      go (CompileMetaError    cme)  = obj "compile-meta-error"    cme+      go (CompileBuildError   cbe)  = obj "compile-build-error"   cbe+      go (CompileRuleError    cre)  = obj "compile-rule-error"    cre+      go (CompilePhonyError   cpe)  = obj "compile-phony-error"   cpe+      go (CompileDefaultError cde)  = obj "compile-default-error" cde+      go (CompilePoolError    cpe)  = obj "compile-pool-error"    cpe++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++-- TODO: add FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------++-- | The type of errors encountered while compiling Ninja metadata.+--+--   @since 0.1.0+data CompileMetaError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericCompileMetaError !Text+  | -- | @Failed to parse `ninja_required_version`: …@+    --+    --   @since 0.1.0+    VersionParseFailure     !Ver.ParsingError+  deriving (Eq, Show, Generic)++-- | Throw a 'CompileMetaError'.+--+--   @since 0.1.0+throwCompileMetaError :: (MonadError CompileError m) => CompileMetaError -> m a+throwCompileMetaError = CompileMetaError .> throwCompileError++-- | Throw a generic catch-all 'CompileMetaError'.+--+--   @since 0.1.0+throwGenericCompileMetaError :: (MonadError CompileError m) => Text -> m a+throwGenericCompileMetaError = GenericCompileMetaError .> throwCompileMetaError++-- | Throw a 'VersionParseFailure' error.+--+--   @since 0.1.0+throwVersionParseFailure :: (MonadError CompileError m)+                         => Ver.ParsingError -> m a+throwVersionParseFailure pe = throwCompileMetaError (VersionParseFailure pe)++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON CompileMetaError where+  toJSON = go+    where+      go (GenericCompileMetaError t) = obj "generic-compile-meta-error" t+      go (VersionParseFailure     e) = obj "version-parse-failure"      (peJ e)++      -- TODO: deduplicate against the implementation in Errors.Parser++      peJ :: M.ParseError Char M.Dec -> Aeson.Value+      peJ (decomposePE -> (pos, custom, unexpected, expected))+        = [ "pos"        .= (posJ     <$> pos)+          , "unexpected" .= (errItemJ <$> unexpected)+          , "expected"   .= (errItemJ <$> expected)+          , "custom"     .= (decJ     <$> custom)+          ] |> Aeson.object++      decomposePE :: M.ParseError Char M.Dec+                  -> ( [M.SourcePos], [M.Dec]+                     , [M.ErrorItem Char], [M.ErrorItem Char] )+      decomposePE (M.ParseError {..})+        = ( toList errorPos, toList errorCustom+          , toList errorUnexpected, toList errorExpected )++      posJ :: M.SourcePos -> Aeson.Value+      posJ (M.SourcePos {..}) = [ "name"   .= sourceName+                                , "line"   .= M.unPos sourceLine+                                , "column" .= M.unPos sourceColumn+                                ] |> Aeson.object++      errItemJ :: M.ErrorItem Char -> Aeson.Value+      errItemJ (M.Tokens xs) = Aeson.toJSON (toList xs)+      errItemJ (M.Label  xs) = Aeson.toJSON (toList xs)+      errItemJ M.EndOfInput  = "eof"++      decJ :: M.Dec -> Aeson.Value+      decJ (M.DecFail message)        = [ "message"  .= message+                                        ] |> Aeson.object |> obj "fail"+      decJ (M.DecIndentation ord x y) = [ "ordering" .= ord+                                        , "start"    .= M.unPos x+                                        , "end"      .= M.unPos y+                                        ] |> Aeson.object |> obj "indentation"++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++-- TODO: add FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------++-- | The type of errors encountered while compiling a Ninja phony @build@.+--+--   @since 0.1.0+data CompilePhonyError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericCompilePhonyError !Text+  deriving (Eq, Show, Generic)++-- | Throw a 'CompilePhonyError'.+--+--   @since 0.1.0+throwCompilePhonyError :: (MonadError CompileError m)+                       => CompilePhonyError -> m a+throwCompilePhonyError = CompilePhonyError .> throwCompileError++-- | Throw a generic catch-all 'CompilePhonyError'.+--+--   @since 0.1.0+throwGenericCompilePhonyError :: (MonadError CompileError m) => Text -> m a+throwGenericCompilePhonyError = GenericCompilePhonyError+                                .> throwCompilePhonyError++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON CompilePhonyError where+  toJSON = go+    where+      go (GenericCompilePhonyError t) = obj "generic-compile-phony-error" t++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++-- TODO: add FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------++-- | The type of errors encountered while compiling a Ninja @default@ statement.+--+--   @since 0.1.0+data CompileDefaultError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericCompileDefaultError !Text+  deriving (Eq, Show, Generic)++-- | Throw a 'CompileDefaultError'.+--+--   @since 0.1.0+throwCompileDefaultError :: (MonadError CompileError m)+                         => CompileDefaultError -> m a+throwCompileDefaultError = CompileDefaultError .> throwCompileError++-- | Throw a generic catch-all 'CompileDefaultError'.+--+--   @since 0.1.0+throwGenericCompileDefaultError :: (MonadError CompileError m) => Text -> m a+throwGenericCompileDefaultError = GenericCompileDefaultError+                                  .> throwCompileDefaultError++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON CompileDefaultError where+  toJSON = go+    where+      go (GenericCompileDefaultError t) = obj "generic-compile-default-error" t++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++-- TODO: add FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------++-- | The type of errors encountered while compiling a Ninja @build@ statement.+--+--   @since 0.1.0+data CompileBuildError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericCompileBuildError !Text+  | -- | @Rule not found: <text>@+    --+    --   @since 0.1.0+    BuildRuleNotFound        !Text+  deriving (Eq, Show, Generic)++-- | Throw a 'CompileBuildError'.+--+--   @since 0.1.0+throwCompileBuildError :: (MonadError CompileError m)+                       => CompileBuildError -> m a+throwCompileBuildError = CompileBuildError .> throwCompileError++-- | Throw a generic catch-all 'CompileBuildError'.+--+--   @since 0.1.0+throwGenericCompileBuildError :: (MonadError CompileError m) => Text -> m a+throwGenericCompileBuildError = GenericCompileBuildError+                                .> throwCompileBuildError++-- | Throw a 'BuildRuleNotFound' error.+--+--   @since 0.1.0+throwBuildRuleNotFound :: (MonadError CompileError m) => Text -> m a+throwBuildRuleNotFound name = throwCompileBuildError (BuildRuleNotFound name)++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON CompileBuildError where+  toJSON = go+    where+      go (GenericCompileBuildError t) = obj "generic-compile-build-error" t+      go (BuildRuleNotFound        n) = obj "build-rule-not-found"        n++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++-- TODO: add FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------++-- | The type of errors encountered while compiling a Ninja @rule@ statement.+--+--   @since 0.1.0+data CompileRuleError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericCompileRuleError !Text+  | -- | @Lookup failed on rule variable: <text>@+    --+    --   @since 0.1.0+    RuleLookupFailure       !Text+  | -- | @Unknown `deps` value: <text>@+    --+    --   @since 0.1.0+    UnknownDepsValue        !Text+  | -- | @Unexpected `msvc_deps_prefix` for `deps = "<text>"`@+    --+    --   @since 0.1.0+    UnexpectedMSVCPrefix    !Text+  deriving (Eq, Show, Generic)++-- | Throw a 'CompileRuleError'.+--+--   @since 0.1.0+throwCompileRuleError :: (MonadError CompileError m) => CompileRuleError -> m a+throwCompileRuleError = CompileRuleError .> throwCompileError++-- | Throw a generic catch-all 'CompileRuleError'.+--+--   @since 0.1.0+throwGenericCompileRuleError :: (MonadError CompileError m) => Text -> m a+throwGenericCompileRuleError = GenericCompileRuleError .> throwCompileRuleError++-- | Throw a 'RuleLookupFailure' error.+--+--   @since 0.1.0+throwRuleLookupFailure :: (MonadError CompileError m) => Text -> m a+throwRuleLookupFailure v = throwCompileRuleError (RuleLookupFailure v)++-- | Throw an 'UnknownDeps' error.+--+--   @since 0.1.0+throwUnknownDeps :: (MonadError CompileError m) => Text -> m a+throwUnknownDeps deps = throwCompileRuleError (UnknownDepsValue deps)++-- | Throw an 'UnexpectedMSVCPrefix' error.+--+--   @since 0.1.0+throwUnexpectedMSVCPrefix :: (MonadError CompileError m) => Text -> m a+throwUnexpectedMSVCPrefix deps = throwCompileRuleError+                                 (UnexpectedMSVCPrefix deps)++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON CompileRuleError where+  toJSON = go+    where+      go (GenericCompileRuleError t) = obj "generic-compile-build-error" t+      go (RuleLookupFailure       n) = obj "rule-lookup-failure"         n+      go (UnknownDepsValue        d) = obj "unknown-deps-value"          d+      go (UnexpectedMSVCPrefix    d) = obj "unexpected-msvc-prefix"      d++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++-- TODO: add FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------++-- | The type of errors encountered while compiling a Ninja @pool@ statement.+--+--   @since 0.1.0+data CompilePoolError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericCompilePoolError !Text+  | -- | @Invalid pool depth for console: <int>@+    --+    --   @since 0.1.0+    InvalidPoolDepth        !Int+  | -- | @Pool name is an empty string@+    --+    --   @since 0.1.0+    EmptyPoolName+  deriving (Eq, Show, Generic)++-- | Throw a 'CompilePoolError'.+--+--   @since 0.1.0+throwCompilePoolError :: (MonadError CompileError m) => CompilePoolError -> m a+throwCompilePoolError = CompilePoolError .> throwCompileError++-- | Throw a generic catch-all 'CompilePoolError'.+--+--   @since 0.1.0+throwGenericCompilePoolError :: (MonadError CompileError m) => Text -> m a+throwGenericCompilePoolError = GenericCompilePoolError .> throwCompilePoolError++-- | Throw an 'InvalidPoolDepth' error.+--+--   @since 0.1.0+throwInvalidPoolDepth :: (MonadError CompileError m) => Int -> m a+throwInvalidPoolDepth d = throwCompilePoolError (InvalidPoolDepth d)++-- | Throw an 'EmptyPoolName' error.+--+--   @since 0.1.0+throwEmptyPoolName :: (MonadError CompileError m) => m a+throwEmptyPoolName = throwCompilePoolError EmptyPoolName++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON CompilePoolError where+  toJSON = go+    where+      go (GenericCompilePoolError t) = obj "generic-compile-pool-error" t+      go (InvalidPoolDepth        d) = obj "invalid-pool-depth"         d+      go EmptyPoolName               = obj "empty-pool-name"            nullJ++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++      nullJ = Aeson.Null :: Aeson.Value++-- TODO: add FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------
+ library/Language/Ninja/Errors/Parser.hs view
@@ -0,0 +1,226 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Errors/Parser.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.++{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ViewPatterns          #-}++-- |+--   Module      : Language.Ninja.Errors.Parser+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Errors thrown during Ninja parsing.+--+--   @since 0.1.0+module Language.Ninja.Errors.Parser+  ( -- * @ParseError@+    ParseError (..)+  , throwParseError, throwGenericParseError+  , throwLexBindingFailure+  , throwLexExpectedColon+  , throwLexUnexpectedDollar+  , throwLexUnexpectedSeparator+  , throwLexParsecError+  , throwParseBadDepthField+  , throwParseUnexpectedBinding+  ) where++import           Control.Exception         (Exception)+import           Control.Monad.Error.Class (MonadError (throwError))+import           GHC.Generics              (Generic)++import           Data.Text                 (Text)++import           Data.Aeson                ((.=))+import qualified Data.Aeson                as Aeson++import qualified Text.Megaparsec           as M++import           Data.Foldable             (toList)++import           Flow                      ((|>))++--------------------------------------------------------------------------------++-- | The type of errors encountered during parsing.+--+--   @since 0.1.0+data ParseError+  = -- | Generic catch-all error constructor. Avoid using this.+    --+    --   @since 0.1.0+    GenericParseError      !Text+  | -- | @Lexer failed at binding: <text>@+    --+    --   @since 0.1.0+    LexBindingFailure      !Text+  | -- | @Expected a colon@+    --+    --   @since 0.1.0+    LexExpectedColon+  | -- | @Unexpected $ followed by unexpected stuff@+    --+    --   @since 0.1.0+    LexUnexpectedDollar+  | -- | Lexer expected a separator character but found something else+    --+    --   @since 0.1.0+    LexUnexpectedSeparator Char+  | -- | Any other lexer error.+    --+    --   @since 0.1.0+    LexParsecError         !(M.ParseError Char M.Dec)+  | -- | @Could not parse depth field in pool, got: <text>@+    --+    --   @since 0.1.0+    ParseBadDepthField     !Text+  | -- | @Unexpected binding defining <text>@+    --+    --   @since 0.1.0+    ParseUnexpectedBinding !Text+  deriving (Eq, Show, Generic)++-- TODO: remove unused errors here++-- | Throw a 'ParseError'.+--+--   @since 0.1.0+throwParseError :: (MonadError ParseError m) => ParseError -> m a+throwParseError = throwError++-- | Throw a generic catch-all 'ParseError'.+--+--   @since 0.1.0+throwGenericParseError :: (MonadError ParseError m) => Text -> m a+throwGenericParseError msg = throwParseError (GenericParseError msg)++-- | Throw a 'LexBindingFailure' error.+--+--   @since 0.1.0+throwLexBindingFailure :: (MonadError ParseError m) => Text -> m a+throwLexBindingFailure t = throwParseError (LexBindingFailure t)++-- | Throw a 'LexExpectedColon' error.+--+--   @since 0.1.0+throwLexExpectedColon :: (MonadError ParseError m) => m a+throwLexExpectedColon = throwParseError LexExpectedColon++-- | Throw a 'LexUnexpectedColon' error.+--+--   @since 0.1.0+throwLexUnexpectedDollar :: (MonadError ParseError m) => m a+throwLexUnexpectedDollar = throwParseError LexUnexpectedDollar++-- | Throw a 'LexUnexpectedSeparator' error.+--+--   @since 0.1.0+throwLexUnexpectedSeparator :: (MonadError ParseError m) => Char -> m a+throwLexUnexpectedSeparator c = throwParseError (LexUnexpectedSeparator c)++-- | Throw a 'LexParsecError' error.+--+--   @since 0.1.0+throwLexParsecError :: (MonadError ParseError m)+                    => M.ParseError Char M.Dec -> m a+throwLexParsecError pe = throwParseError (LexParsecError pe)++-- | Throw a 'ParseBadDepthField' error.+--+--   @since 0.1.0+throwParseBadDepthField :: (MonadError ParseError m) => Text -> m a+throwParseBadDepthField t = throwParseError (ParseBadDepthField t)++-- | Throw a 'ParseUnexpectedBinding' error.+--+--   @since 0.1.0+throwParseUnexpectedBinding :: (MonadError ParseError m) => Text -> m a+throwParseUnexpectedBinding t = throwParseError (ParseUnexpectedBinding t)++-- | Default instance.+--+--   @since 0.1.0+instance Exception ParseError++-- | Converts to @{tag: …, value: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON ParseError where+  toJSON = go+    where+      go (GenericParseError t)      = obj "generic-parse-error"      t+      go (LexBindingFailure t)      = obj "lex-binding-failure"      t+      go LexExpectedColon           = obj "lex-expected-colon"       nullJ+      go LexUnexpectedDollar        = obj "lex-unexpected-dollar"    nullJ+      go (LexUnexpectedSeparator c) = obj "lex-unexpected-separator" c+      go (LexParsecError pe)        = obj "lex-parsec-error"         (peJ pe)+      go (ParseBadDepthField t)     = obj "parse-bad-depth-field"    t+      go (ParseUnexpectedBinding t) = obj "parse-unexpected-binding" t++      peJ :: M.ParseError Char M.Dec -> Aeson.Value+      peJ (decomposePE -> (pos, custom, unexpected, expected))+        = [ "pos"        .= (posJ     <$> pos)+          , "unexpected" .= (errItemJ <$> unexpected)+          , "expected"   .= (errItemJ <$> expected)+          , "custom"     .= (decJ     <$> custom)+          ] |> Aeson.object++      decomposePE :: M.ParseError Char M.Dec+                  -> ( [M.SourcePos], [M.Dec]+                     , [M.ErrorItem Char], [M.ErrorItem Char] )+      decomposePE (M.ParseError {..})+        = ( toList errorPos, toList errorCustom+          , toList errorUnexpected, toList errorExpected )++      posJ :: M.SourcePos -> Aeson.Value+      posJ (M.SourcePos {..}) = [ "name"   .= sourceName+                                , "line"   .= M.unPos sourceLine+                                , "column" .= M.unPos sourceColumn+                                ] |> Aeson.object++      errItemJ :: M.ErrorItem Char -> Aeson.Value+      errItemJ (M.Tokens xs) = Aeson.toJSON (toList xs)+      errItemJ (M.Label  xs) = Aeson.toJSON (toList xs)+      errItemJ M.EndOfInput  = "eof"++      decJ :: M.Dec -> Aeson.Value+      decJ (M.DecFail message)        = [ "message"  .= message+                                        ] |> Aeson.object |> obj "fail"+      decJ (M.DecIndentation ord x y) = [ "ordering" .= ord+                                        , "start"    .= M.unPos x+                                        , "end"      .= M.unPos y+                                        ] |> Aeson.object |> obj "indentation"++      obj :: (Aeson.ToJSON x) => Text -> x -> Aeson.Value+      obj tag value = Aeson.object ["tag" .= tag, "value" .= value]++      nullJ = Aeson.Null :: Aeson.Value++-- TODO: add a FromJSON instance+-- TODO: add Arbitrary instance+-- TODO: add (Co)Serial instance++--------------------------------------------------------------------------------
+ library/Language/Ninja/IR.hs view
@@ -0,0 +1,91 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/IR.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-missing-import-lists #-}++-- |+--   Module      : Language.Ninja.IR+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   The Ninja build language intermediate representation after compilation.+--+--   This module re-exports all of the modules under the "Language.Ninja.IR"+--   namespace for convenience.+--+--   It is recommended that you import it with the following style:+--+--   > import qualified Language.Ninja.IR as IR+--+--   @since 0.1.0+module Language.Ninja.IR+  ( -- * "Language.Ninja.IR.Ninja"+    IR.Ninja, IR.makeNinja+  , IR.ninjaMeta, IR.ninjaBuilds, IR.ninjaPhonys+  , IR.ninjaDefaults, IR.ninjaPools++    -- * "Language.Ninja.IR.Meta"+  , IR.Meta, IR.makeMeta, IR.metaReqVersion, IR.metaBuildDir++    -- * "Language.Ninja.IR.Build"+  , IR.Build, IR.makeBuild, IR.buildRule, IR.buildOuts, IR.buildDeps++    -- * "Language.Ninja.IR.Rule"+  , IR.Rule, IR.makeRule+  , IR.ruleName, IR.ruleCommand, IR.ruleDescription, IR.rulePool, IR.ruleDepfile+  , IR.ruleSpecialDeps, IR.ruleGenerator, IR.ruleRestat, IR.ruleResponseFile++  , IR.SpecialDeps, IR.makeSpecialDepsGCC, IR.makeSpecialDepsMSVC+  , IR._SpecialDepsGCC, IR._SpecialDepsMSVC++  , IR.ResponseFile, IR.makeResponseFile+  , IR.responseFilePath, IR.responseFileContent++    -- * "Language.Ninja.IR.Target"+  , IR.Target, IR.makeTarget+  , IR.targetIText, IR.targetText++  , IR.Output, IR.makeOutput, IR.outputTarget++  , IR.Dependency, IR.makeDependency, IR.dependencyTarget, IR.dependencyType+  , IR.DependencyType (..), IR._NormalDependency, IR._OrderOnlyDependency++    -- * "Language.Ninja.IR.Pool"+  , IR.Pool+  , IR.makePool, IR.makePoolDefault, IR.makePoolConsole, IR.makePoolCustom+  , IR.poolName, IR.poolDepth++  , IR.PoolName+  , IR.makePoolNameDefault, IR.makePoolNameConsole, IR.makePoolNameCustom+  , IR._PoolNameDefault, IR._PoolNameConsole, IR._PoolNameCustom+  , IR.poolNameText, IR.printPoolName, IR.parsePoolName++  , IR.PoolDepth+  , IR.makePoolDepth, IR.makePoolInfinite+  , IR.poolDepthPositive+  ) where++import           Language.Ninja.IR.Build  as IR+import           Language.Ninja.IR.Meta   as IR+import           Language.Ninja.IR.Ninja  as IR+import           Language.Ninja.IR.Pool   as IR+import           Language.Ninja.IR.Rule   as IR+import           Language.Ninja.IR.Target as IR
+ library/Language/Ninja/IR/Build.hs view
@@ -0,0 +1,167 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/IR/Build.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.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.IR.Build+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A datatype for Ninja @build@ declarations.+--+--   @since 0.1.0+module Language.Ninja.IR.Build+  ( -- * @Build@+    Build, makeBuild, buildRule, buildOuts, buildDeps+  , BuildConstraint+  ) where++import qualified Control.Lens             as Lens++import           Data.Aeson               ((.:), (.=))+import qualified Data.Aeson               as Aeson++import           Data.Text                (Text)++import           Data.HashSet             (HashSet)+import qualified Data.HashSet             as HS++import           Control.DeepSeq          (NFData)+import           Data.Hashable            (Hashable)+import           GHC.Generics             (Generic)+import qualified Test.SmallCheck.Series   as SC++import           GHC.Exts                 (Constraint)++import           Language.Ninja.IR.Rule   (Rule)+import           Language.Ninja.IR.Target (Dependency, Output)++import           Flow                     ((|>))++--------------------------------------------------------------------------------++-- | A Ninja @build@ declaration, as documented+--   <https://ninja-build.org/manual.html#_build_statements here>.+--+--   @since 0.1.0+data Build+  = MkBuild+    { _buildRule :: !Rule+    , _buildOuts :: !(HashSet Output)+    , _buildDeps :: !(HashSet Dependency)+    }+  deriving (Eq, Show, Generic)++-- | Construct a default 'Build' from the given 'Rule'+--+--   @since 0.1.0+{-# INLINE makeBuild #-}+makeBuild :: Rule -> Build+makeBuild rule = MkBuild+                 { _buildRule = rule+                 , _buildOuts = HS.empty+                 , _buildDeps = HS.empty+                 }++-- | The rule to execute when building any of the outputs.+--+--   @since 0.1.0+{-# INLINE buildRule #-}+buildRule :: Lens.Lens' Build Rule+buildRule = Lens.lens _buildRule+            $ \(MkBuild {..}) x -> MkBuild { _buildRule = x, .. }++-- | The outputs that are built as a result of rule execution.+--+--   @since 0.1.0+{-# INLINE buildOuts #-}+buildOuts :: Lens.Lens' Build (HashSet Output)+buildOuts = Lens.lens _buildOuts+            $ \(MkBuild {..}) x -> MkBuild { _buildOuts = x, .. }++-- | The dependencies that must be satisfied before this can be built.+--+--   @since 0.1.0+{-# INLINE buildDeps #-}+buildDeps :: Lens.Lens' Build (HashSet Dependency)+buildDeps = Lens.lens _buildDeps+            $ \(MkBuild {..}) x -> MkBuild { _buildDeps = x, .. }++-- | Converts to @{rule: …, outputs: …, dependencies: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Build where+  toJSON (MkBuild {..})+    = [ "rule"         .= _buildRule+      , "outputs"      .= _buildOuts+      , "dependencies" .= _buildDeps+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Build where+  parseJSON = (Aeson.withObject "Build" $ \o -> do+                  _buildRule <- (o .: "rule")         >>= pure+                  _buildOuts <- (o .: "outputs")      >>= pure+                  _buildDeps <- (o .: "dependencies") >>= pure+                  pure (MkBuild {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Build++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Build++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, BuildConstraint (SC.Serial m)) => SC.Serial m Build++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, BuildConstraint (SC.CoSerial m)) => SC.CoSerial m Build++-- | The set of constraints required for a given constraint to be automatically+--   computed for a 'Build'.+--+--   @since 0.1.0+type BuildConstraint (c :: * -> Constraint)+  = ( c Text+    , c (HashSet Output)+    , c (HashSet Dependency)+    )++--------------------------------------------------------------------------------
+ library/Language/Ninja/IR/Meta.hs view
@@ -0,0 +1,168 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/IR/Meta.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.++{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.IR.Meta+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A datatype for Ninja top-level variables and other metadata.+--+--   @since 0.1.0+module Language.Ninja.IR.Meta+  ( -- * @Meta@+    Meta, makeMeta, metaReqVersion, metaBuildDir+  ) where++import           Data.Aeson               ((.:), (.=))+import qualified Data.Aeson               as Aeson+import qualified Data.Aeson.Types         as Aeson++import           Data.Text                (Text)++import           Control.DeepSeq          (NFData)+import           Data.Hashable            (Hashable)+import           GHC.Generics             (Generic)+import qualified Test.SmallCheck.Series   as SC++import qualified Data.Versions            as Ver++import qualified Text.Megaparsec          as Mega++import           Language.Ninja.Misc.Path (Path)++import qualified Control.Lens             as Lens++import           Flow                     ((.>), (|>))++--------------------------------------------------------------------------------++-- | Ninja top-level metadata, as documented+--   <https://ninja-build.org/manual.html#ref_toplevel here>.+--+--   @since 0.1.0+data Meta+  = MkMeta+    { _metaReqVersion :: !(Maybe Ver.Version)+    , _metaBuildDir   :: !(Maybe Path)+    }+  deriving (Eq, Ord, Show, Generic)++-- | Construct a default 'Meta' value.+--+--   @since 0.1.0+{-# INLINE makeMeta #-}+makeMeta :: Meta+makeMeta = MkMeta+           { _metaReqVersion = Nothing+           , _metaBuildDir   = Nothing+           }++-- | Corresponds to the @ninja_required_version@ top-level variable.+--+--   @since 0.1.0+{-# INLINE metaReqVersion #-}+metaReqVersion :: Lens.Lens' Meta (Maybe Ver.Version)+metaReqVersion = Lens.lens _metaReqVersion+                 $ \(MkMeta {..}) x -> MkMeta { _metaReqVersion = x, .. }++-- | Corresponds to the @builddir@ top-level variable.+--+--   @since 0.1.0+{-# INLINE metaBuildDir #-}+metaBuildDir :: Lens.Lens' Meta (Maybe Path)+metaBuildDir = Lens.lens _metaBuildDir+               $ \(MkMeta {..}) x -> MkMeta { _metaBuildDir = x, .. }++-- | Converts to @{req-version: …, build-dir: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Meta where+  toJSON (MkMeta {..})+    = [ "req-version" .= fmap versionJ _metaReqVersion+      , "build-dir"   .= _metaBuildDir+      ] |> Aeson.object+    where+      versionJ :: Ver.Version -> Aeson.Value+      versionJ = Ver.prettyVer .> Aeson.toJSON++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Meta where+  parseJSON = (Aeson.withObject "Meta" $ \o -> do+                  _metaReqVersion <- (o .: "req-version") >>= maybeVersionP+                  _metaBuildDir   <- (o .: "build-dir")   >>= pure+                  pure (MkMeta {..}))+    where+      maybeVersionP :: Maybe Aeson.Value -> Aeson.Parser (Maybe Ver.Version)+      maybeVersionP = fmap versionP .> sequenceA++      versionP :: Aeson.Value -> Aeson.Parser Ver.Version+      versionP = Aeson.withText "Version" (megaparsecToAeson Ver.version')++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Meta++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Meta++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.Serial m Ver.Version+         , SC.Serial m Text+         ) => SC.Serial m Meta++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.CoSerial m Ver.Version+         , SC.CoSerial m Text+         ) => SC.CoSerial m Meta++--------------------------------------------------------------------------------++-- This function converts a @megaparsec@ parser to an @aeson@ parser.+-- Mainly, it handles converting the error output from @megaparsec@ to a+-- string that is appropriate for 'fail'.+megaparsecToAeson :: Mega.Parsec Mega.Dec Text t+                  -> (Text -> Aeson.Parser t)+megaparsecToAeson parser text = case Mega.runParser parser "" text of+                                  Left  e -> fail (Mega.parseErrorPretty e)+                                  Right x -> pure x++--------------------------------------------------------------------------------
+ library/Language/Ninja/IR/Ninja.hs view
@@ -0,0 +1,205 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/IR/Ninja.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.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.IR.Ninja+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A datatype representing the intermediate representation of a Ninja file+--   after compilation.+--+--   @since 0.1.0+module Language.Ninja.IR.Ninja+  ( -- * @Ninja@+    Ninja, makeNinja+  , ninjaMeta, ninjaBuilds, ninjaPhonys, ninjaDefaults, ninjaPools+  , NinjaConstraint+  ) where++import qualified Control.Lens             as Lens++import           Data.Text                (Text)++import           Data.HashMap.Strict      (HashMap)+import qualified Data.HashMap.Strict      as HM++import           Data.HashSet             (HashSet)+import qualified Data.HashSet             as HS++import           Data.Aeson               ((.:), (.=))+import qualified Data.Aeson               as Aeson++import qualified Data.Versions            as Ver++import           Control.DeepSeq          (NFData)+import           Data.Hashable            (Hashable)+import           GHC.Generics             (Generic)+import qualified Test.SmallCheck.Series   as SC++import           GHC.Exts                 (Constraint)++import           Language.Ninja.IR.Build  (Build)+import           Language.Ninja.IR.Meta   (Meta)+import qualified Language.Ninja.IR.Meta   as Ninja+import           Language.Ninja.IR.Pool   (Pool)+import           Language.Ninja.IR.Target (Target)++import           Flow                     ((|>))++--------------------------------------------------------------------------------++-- | A parsed and normalized Ninja file.+--+--   @since 0.1.0+data Ninja+  = MkNinja+    { _ninjaMeta     :: !Meta+    , _ninjaBuilds   :: !(HashSet Build)+    , _ninjaPhonys   :: !(HashMap Target (HashSet Target))+    , _ninjaDefaults :: !(HashSet Target)+    , _ninjaPools    :: !(HashSet Pool)+    }+  deriving (Eq, Show, Generic)++-- | Construct a default 'Ninja' value.+--+--   @since 0.1.0+{-# INLINE makeNinja #-}+makeNinja :: Ninja+makeNinja = MkNinja+            { _ninjaMeta     = Ninja.makeMeta+            , _ninjaBuilds   = HS.empty+            , _ninjaPhonys   = HM.empty+            , _ninjaDefaults = HS.empty+            , _ninjaPools    = HS.empty+            }++-- | Metadata, which includes top-level variables like @builddir@.+--+--   @since 0.1.0+{-# INLINE ninjaMeta #-}+ninjaMeta :: Lens.Lens' Ninja Meta+ninjaMeta = Lens.lens _ninjaMeta+            $ \(MkNinja {..}) x -> MkNinja { _ninjaMeta = x, .. }++-- | Compiled @build@ declarations.+--+--   @since 0.1.0+{-# INLINE ninjaBuilds #-}+ninjaBuilds :: Lens.Lens' Ninja (HashSet Build)+ninjaBuilds = Lens.lens _ninjaBuilds+              $ \(MkNinja {..}) x -> MkNinja { _ninjaBuilds = x, .. }++-- | Phony targets, as documented+--   <https://ninja-build.org/manual.html#_more_details here>.+--+--   @since 0.1.0+{-# INLINE ninjaPhonys #-}+ninjaPhonys :: Lens.Lens' Ninja (HashMap Target (HashSet Target))+ninjaPhonys = Lens.lens _ninjaPhonys+              $ \(MkNinja {..}) x -> MkNinja { _ninjaPhonys = x, .. }++-- | The set of default targets, as documented+--   <https://ninja-build.org/manual.html#_default_target_statements here>.+--+--   @since 0.1.0+{-# INLINE ninjaDefaults #-}+ninjaDefaults :: Lens.Lens' Ninja (HashSet Target)+ninjaDefaults = Lens.lens _ninjaDefaults+                $ \(MkNinja {..}) x -> MkNinja { _ninjaDefaults = x, .. }++-- | The set of pools for this Ninja file.+--+--   @since 0.1.0+{-# INLINE ninjaPools #-}+ninjaPools :: Lens.Lens' Ninja (HashSet Pool)+ninjaPools = Lens.lens _ninjaPools+             $ \(MkNinja {..}) x -> MkNinja { _ninjaPools = x, .. }++-- | Converts to @{meta: …, builds: …, phonys: …, defaults: …, pools: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Ninja where+  toJSON (MkNinja {..})+    = [ "meta"     .= _ninjaMeta+      , "builds"   .= _ninjaBuilds+      , "phonys"   .= _ninjaPhonys+      , "defaults" .= _ninjaDefaults+      , "pools"    .= _ninjaPools+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Ninja where+  parseJSON = (Aeson.withObject "Ninja" $ \o -> do+                  _ninjaMeta     <- (o .: "meta")     >>= pure+                  _ninjaBuilds   <- (o .: "builds")   >>= pure+                  _ninjaPhonys   <- (o .: "phonys")   >>= pure+                  _ninjaDefaults <- (o .: "defaults") >>= pure+                  _ninjaPools    <- (o .: "pools")    >>= pure+                  pure (MkNinja {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Ninja++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Ninja++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, NinjaConstraint (SC.Serial m)) => SC.Serial m Ninja++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, NinjaConstraint (SC.CoSerial m)) => SC.CoSerial m Ninja++-- | The set of constraints required for a given constraint to be automatically+--   computed for a 'Ninja'.+--+--   @since 0.1.0+type NinjaConstraint (c :: * -> Constraint)+  = ( c Text+    , c Ver.Version+    , c (HashMap Target (HashSet Target))+    , c (HashSet Build)+    , c (HashSet Target)+    , c (HashSet Pool)+    )++--------------------------------------------------------------------------------
+ library/Language/Ninja/IR/Pool.hs view
@@ -0,0 +1,442 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/IR/Pool.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.++{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.IR.Pool+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Types relating to Ninja @pool@s.+--+--   @since 0.1.0+module Language.Ninja.IR.Pool+  ( -- * @Pool@+    Pool, makePool, makePoolDefault, makePoolConsole, makePoolCustom+  , poolName, poolDepth++    -- * @PoolName@+  , PoolName, makePoolNameDefault, makePoolNameConsole, makePoolNameCustom+  , _PoolNameDefault, _PoolNameConsole, _PoolNameCustom+  , poolNameText, printPoolName, parsePoolName++    -- * @PoolDepth@+  , PoolDepth+  , makePoolDepth, makePoolInfinite+  , poolDepthPositive+  ) where++import           Control.Applicative          (empty)++import qualified Control.Lens                 as Lens++import           Data.Aeson                   ((.:), (.=))+import qualified Data.Aeson                   as Aeson+import qualified Data.Aeson.Types             as Aeson++import           Data.Text                    (Text)+import qualified Data.Text                    as Text++import           Control.DeepSeq              (NFData)+import           Data.Hashable                (Hashable)+import           Data.String                  (IsString (fromString))+import           GHC.Generics                 (Generic)++import           Test.SmallCheck.Series       ((<~>), (\/))+import qualified Test.SmallCheck.Series       as SC++import qualified Language.Ninja.Misc.Positive as Misc++import           Flow                         ((.>), (|>))++--------------------------------------------------------------------------------++-- | A Ninja @pool@ declaration, as documented+--   <https://ninja-build.org/manual.html#ref_pool here>.+--+--   @since 0.1.0+data Pool+  = MkPool+    { _poolName  :: !PoolName+    , _poolDepth :: !PoolDepth+    }+  deriving (Eq, Ord, Show, Read, Generic)++-- | Construct a 'Pool', given its name and depth.+--+--   @since 0.1.0+{-# INLINEABLE makePool #-}+makePool :: PoolName -> PoolDepth -> Maybe Pool+makePool PoolNameDefault    PoolInfinite  = Just makePoolDefault+makePool PoolNameConsole    (PoolDepth 1) = Just makePoolConsole+makePool (PoolNameCustom t) (PoolDepth d) = if d >= 1+                                            then Just (makePoolCustom t d)+                                            else Nothing+makePool _                  _             = Nothing++-- | The default pool, i.e.: the one whose name is the empty string.+--+--   @since 0.1.0+{-# INLINE makePoolDefault #-}+makePoolDefault :: Pool+makePoolDefault = MkPool makePoolNameDefault PoolInfinite++-- | The @console@ pool.+--+--   @since 0.1.0+{-# INLINE makePoolConsole #-}+makePoolConsole :: Pool+makePoolConsole = MkPool makePoolNameConsole (PoolDepth 1)++-- | Create a pool with the given name and depth.+--+--   @since 0.1.0+{-# INLINE makePoolCustom #-}+makePoolCustom :: Text          -- ^ The pool name.+               -> Misc.Positive -- ^ The pool depth.+               -> Pool+makePoolCustom name depth = MkPool (makePoolNameCustom name) (PoolDepth depth)++-- | A 'Getter' that gives the name of a pool.+--+--   @since 0.1.0+{-# INLINE poolName #-}+poolName :: Lens.Getter Pool PoolName+poolName = Lens.to _poolName++-- | A 'Getter' that gives the depth of a pool.+--+--   @since 0.1.0+{-# INLINE poolDepth #-}+poolDepth :: Lens.Getter Pool PoolDepth+poolDepth = Lens.to _poolDepth++-- | Converts to @{name: …, depth: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Pool where+  toJSON (MkPool {..})+    = [ "name"  .= _poolName+      , "depth" .= _poolDepth+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Pool where+  parseJSON = (Aeson.withObject "Pool" $ \o -> do+                  _poolName  <- (o .: "name")  >>= pure+                  _poolDepth <- (o .: "depth") >>= pure+                  pure (MkPool {..}))++-- | Uses the underlying instances.+--+--   @since 0.1.0+instance forall m. (Monad m, SC.Serial m Text) => SC.Serial m Pool where+  series = pure makePoolDefault+           \/ pure makePoolConsole+           \/ (let nameSeries :: SC.Series m Text+                   nameSeries = SC.series >>= (\case ""        -> empty+                                                     "console" -> empty+                                                     x         -> pure x)+               in makePoolCustom <$> nameSeries <~> SC.series)++-- | Uses the underlying instances.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m Pool where+  coseries = SC.coseries .> fmap (\f -> convert .> f)+    where+      convert :: Pool -> (PoolName, PoolDepth)+      convert pool = (Lens.view poolName pool, Lens.view poolDepth pool)++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Pool++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Pool++--------------------------------------------------------------------------------++-- | The name of a Ninja pool.+--+--   More information is available+--   <https://ninja-build.org/manual.html#ref_pool here>.+--+--   @since 0.1.0+data PoolName+  = PoolNameDefault+  | PoolNameConsole+  | PoolNameCustom !Text+  deriving (Eq, Ord, Show, Read, Generic)++-- | Create a 'PoolName' corresponding to the built-in default pool, i.e.: the+--   pool that is selected if the @pool@ attribute is set to the empty string.+--+--   @since 0.1.0+{-# INLINE makePoolNameDefault #-}+makePoolNameDefault :: PoolName+makePoolNameDefault = PoolNameDefault++-- | Create a 'PoolName' corresponding to the built-in @console@ pool.+--+--   @since 0.1.0+{-# INLINE makePoolNameConsole #-}+makePoolNameConsole :: PoolName+makePoolNameConsole = PoolNameConsole++-- | Create a 'PoolName' corresponding to a custom pool.+--   Note: this can fail at runtime if given the empty string or @"console"@,+--   so you should consider 'parsePoolName' as a safer alternative.+--+--   @since 0.1.0+{-# INLINEABLE makePoolNameCustom #-}+makePoolNameCustom :: Text -> PoolName+makePoolNameCustom ""        = error "Invalid pool name: \"\""+makePoolNameCustom "console" = error "Invalid pool name: \"console\""+makePoolNameCustom text      = PoolNameCustom text++-- | A one-way prism corresponding to the 'poolNameDefault' constructor.+--+--   @since 0.1.0+{-# INLINE _PoolNameDefault #-}+_PoolNameDefault :: Lens.Getter PoolName (Maybe ())+_PoolNameDefault = Lens.to (\case PoolNameDefault -> Just ()+                                  _               -> Nothing)++-- | A one-way prism corresponding to the 'poolNameConsole' constructor.+--+--   @since 0.1.0+{-# INLINE _PoolNameConsole #-}+_PoolNameConsole :: Lens.Getter PoolName (Maybe ())+_PoolNameConsole = Lens.to (\case PoolNameConsole -> Just ()+                                  _               -> Nothing)++-- | A one-way prism corresponding to the 'poolNameConsole' constructor.+--+--   @since 0.1.0+{-# INLINE _PoolNameCustom #-}+_PoolNameCustom :: Lens.Getter PoolName (Maybe Text)+_PoolNameCustom = Lens.to (\case (PoolNameCustom t) -> Just t+                                 _                  -> Nothing)++-- | An isomorphism between a 'PoolName' and the corresponding 'Text'.+--   Equivalent to @'Lens.iso' 'printPoolName' 'parsePoolName'@.+--+--   @since 0.1.0+{-# INLINE poolNameText #-}+poolNameText :: Lens.Iso' PoolName Text+poolNameText = Lens.iso printPoolName parsePoolName++-- | Convert a 'PoolName' to the string that, if the @pool@ attribute is set to+--   it, will cause the given 'PoolName' to be parsed.+--+--   >>> printPoolName makePoolNameDefault+--   ""+--+--   >>> printPoolName makePoolNameConsole+--   "console"+--+--   >>> printPoolName (makePoolNameCustom "foobar")+--   "foobar"+--+--   @since 0.1.0+{-# INLINEABLE printPoolName #-}+printPoolName :: PoolName -> Text+printPoolName PoolNameDefault    = ""+printPoolName PoolNameConsole    = "console"+printPoolName (PoolNameCustom t) = t++-- | Inverse of 'printPoolName'.+--+--   >>> parsePoolName ""+--   PoolNameDefault+--+--   >>> parsePoolName "console"+--   PoolNameConsole+--+--   >>> parsePoolName "foobar"+--   PoolNameCustom "foobar"+--+--   @since 0.1.0+{-# INLINEABLE parsePoolName #-}+parsePoolName :: Text -> PoolName+parsePoolName ""        = makePoolNameDefault+parsePoolName "console" = makePoolNameConsole+parsePoolName t         = makePoolNameCustom t++-- | Converts from string via 'parsePoolName'.+--+--   @since 0.1.0+instance IsString PoolName where+  fromString = Text.pack .> parsePoolName++-- | Converts to JSON string via 'printPoolName'.+--+--   @since 0.1.0+instance Aeson.ToJSON PoolName where+  toJSON = printPoolName .> Aeson.String++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON PoolName where+  parseJSON = Aeson.withText "PoolName" (parsePoolName .> pure)++-- | Converts to JSON string via 'printPoolName'.+--+--   @since 0.1.0+instance Aeson.ToJSONKey PoolName where+  toJSONKey = Aeson.toJSONKeyText printPoolName++-- | Inverse of the 'Aeson.ToJSONKey' instance.+--+--   @since 0.1.0+instance Aeson.FromJSONKey PoolName where+  fromJSONKey = Aeson.mapFromJSONKeyFunction parsePoolName Aeson.fromJSONKey++-- | Uses the underlying 'Text' instance.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m PoolName where+  series = parsePoolName <$> (pure "" \/ pure "console" \/ SC.series)++-- | Uses the underlying 'Text' instance.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m PoolName where+  coseries = SC.coseries+             .> fmap (\f -> printPoolName .> f)++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable PoolName++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData PoolName++--------------------------------------------------------------------------------++-- | The depth of a Ninja pool.+--+--   More information is available+--   <https://ninja-build.org/manual.html#ref_pool here>.+--+--   @since 0.1.0+data PoolDepth+  = PoolDepth !Misc.Positive+  | PoolInfinite+  deriving (Eq, Ord, Show, Read, Generic)++-- | Construct a finite 'PoolDepth' from an integer, which should be a number+--   greater than or equal to 1.+--+--   @since 0.1.0+{-# INLINE makePoolDepth #-}+makePoolDepth :: Misc.Positive -> PoolDepth+makePoolDepth = PoolDepth++-- | Construct an infinite 'PoolDepth'. This constructor is needed for the+--   default pool (@pool = ""@), which has an infinite depth.+--+--   @since 0.1.0+{-# INLINE makePoolInfinite #-}+makePoolInfinite :: PoolDepth+makePoolInfinite = PoolInfinite++-- | An isomorphism between a 'PoolDepth' and a @'Maybe' 'Misc.Positive'@;+--   the 'Nothing' case maps to 'makePoolInfinite' and the 'Just' case+--   maps to 'makePoolDepth'.+--+--   @since 0.1.0+{-# INLINE poolDepthPositive #-}+poolDepthPositive :: Lens.Iso' PoolDepth (Maybe Misc.Positive)+poolDepthPositive = Lens.iso fromPD toPD+  where+    {-# INLINE fromPD #-}+    fromPD :: PoolDepth -> Maybe Misc.Positive+    fromPD (PoolDepth p) = Just p+    fromPD PoolInfinite  = Nothing++    {-# INLINE toPD #-}+    toPD :: Maybe Misc.Positive -> PoolDepth+    toPD (Just p) = PoolDepth p+    toPD Nothing  = PoolInfinite++-- | Converts 'makePoolInfinite' to @"infinite"@ and 'makePoolDepth' to the+--   corresponding JSON number.+--+--   @since 0.1.0+instance Aeson.ToJSON PoolDepth where+  toJSON (PoolDepth i) = Aeson.toJSON i+  toJSON PoolInfinite  = "infinite"++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON PoolDepth where+  parseJSON (v@(Aeson.Number _))      = PoolDepth <$> Aeson.parseJSON v+  parseJSON (Aeson.String "infinite") = pure PoolInfinite+  parseJSON owise                     = Aeson.typeMismatch "PoolDepth" owise++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m) => SC.Serial m PoolDepth where+  series = pure PoolInfinite+           \/ (SC.series |> fmap PoolDepth)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m) => SC.CoSerial m PoolDepth where+  coseries = SC.coseries+             .> fmap (\f -> \case (PoolDepth i) -> f (Just i)+                                  PoolInfinite  -> f Nothing)++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable PoolDepth++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData PoolDepth++--------------------------------------------------------------------------------
+ library/Language/Ninja/IR/Rule.hs view
@@ -0,0 +1,447 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/IR/Rule.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.++{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Language.Ninja.IR.Rule+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A datatype for Ninja @rule@ declarations.+--+--   @since 0.1.0+module Language.Ninja.IR.Rule+  ( -- * @Rule@+    Rule, makeRule+  , ruleName, ruleCommand, ruleDescription, rulePool, ruleDepfile+  , ruleSpecialDeps, ruleGenerator, ruleRestat, ruleResponseFile++    -- * @SpecialDeps@+  , SpecialDeps, makeSpecialDepsGCC, makeSpecialDepsMSVC+  , _SpecialDepsGCC, _SpecialDepsMSVC++    -- * @ResponseFile@+  , ResponseFile, makeResponseFile, responseFilePath, responseFileContent+  ) where++import qualified Control.Lens                as Lens++import           Data.Text                   (Text)+import qualified Data.Text                   as Text++import           Data.Aeson                  ((.:), (.=))+import qualified Data.Aeson                  as Aeson++import           Control.DeepSeq             (NFData)+import           Data.Hashable               (Hashable)+import           GHC.Generics                (Generic)+import qualified Test.SmallCheck.Series      as SC++import           Language.Ninja.IR.Pool      (PoolName, makePoolNameDefault)+import           Language.Ninja.Misc.Command (Command)+import           Language.Ninja.Misc.Path    (Path)++import           Flow                        ((|>))++--------------------------------------------------------------------------------++-- | A Ninja @rule@ declaration, as documented+--   <https://ninja-build.org/manual.html#_rules here>.+--+--   @since 0.1.0+data Rule+  = MkRule+    { _ruleName         :: !Text+    , _ruleCommand      :: !Command+    , _ruleDescription  :: !(Maybe Text)+    , _rulePool         :: !PoolName+    , _ruleDepfile      :: !(Maybe Path)+    , _ruleSpecialDeps  :: !(Maybe SpecialDeps)+    , _ruleGenerator    :: !Bool+    , _ruleRestat       :: !Bool+    , _ruleResponseFile :: !(Maybe ResponseFile)+    }+  deriving (Eq, Ord, Show, Generic)++-- | Construct an 'Rule' with the given name and command, with default values+--   for all other attributes (e.g.: 'False', 'Nothing', 'poolDefault').+--+--   @since 0.1.0+{-# INLINE makeRule #-}+makeRule :: Text+         -- ^ The rule name.+         -> Command+         -- ^ The command to run.+         -> Rule+         -- ^ A rule that runs this command.+makeRule name cmd+  = MkRule+    { _ruleName         = name+    , _ruleCommand      = cmd+    , _ruleDescription  = Nothing+    , _rulePool         = makePoolNameDefault+    , _ruleDepfile      = Nothing+    , _ruleSpecialDeps  = Nothing+    , _ruleGenerator    = False+    , _ruleRestat       = False+    , _ruleResponseFile = Nothing+    }++-- | The name of the rule.+--+--   @since 0.1.0+{-# INLINE ruleName #-}+ruleName :: Lens.Lens' Rule Text+ruleName = Lens.lens _ruleName+           $ \(MkRule {..}) x -> MkRule { _ruleName = x, .. }++-- | The command that this rule will run.+--+--   @since 0.1.0+{-# INLINE ruleCommand #-}+ruleCommand :: Lens.Lens' Rule Command+ruleCommand = Lens.lens _ruleCommand+              $ \(MkRule {..}) x -> MkRule { _ruleCommand = x, .. }++-- | A short description of the command, used to pretty-print the command+--   as it's running. The @ninja -v@ flag controls whether to print the+--   full command or its description; if a command fails, the full command+--   line will always be printed before the command's output.+--+--   @since 0.1.0+{-# INLINE ruleDescription #-}+ruleDescription :: Lens.Lens' Rule (Maybe Text)+ruleDescription = Lens.lens _ruleDescription+                  $ \(MkRule {..}) x -> MkRule { _ruleDescription = x, .. }++-- | The process pool in which this rule will be executed.+--+--   @since 0.1.0+{-# INLINE rulePool #-}+rulePool :: Lens.Lens' Rule PoolName+rulePool = Lens.lens _rulePool+           $ \(MkRule {..}) x -> MkRule { _rulePool = x, .. }++-- | If set, this should be a path to an optional Makefile that contains+--   extra implicit dependencies. This is used to support C/C++ header+--   dependencies. For more information, read the Ninja documentation+--   <https://ninja-build.org/manual.html#_depfile here>.+--+--   @since 0.1.0+{-# INLINE ruleDepfile #-}+ruleDepfile :: Lens.Lens' Rule (Maybe Path)+ruleDepfile = Lens.lens _ruleDepfile+              $ \(MkRule {..}) x -> MkRule { _ruleDepfile = x, .. }++-- | If set, enables special dependency processing used in C/C++ header+--   dependencies. For more information, read the Ninja documentation+--   <https://ninja-build.org/manual.html#_deps here>.+--+--   @since 0.1.0+{-# INLINE ruleSpecialDeps #-}+ruleSpecialDeps :: Lens.Lens' Rule (Maybe SpecialDeps)+ruleSpecialDeps = Lens.lens _ruleSpecialDeps+                  $ \(MkRule {..}) x -> MkRule { _ruleSpecialDeps = x, .. }++-- | If this is true, specifies that this rule is used to re-invoke the+--   generator program. Files built using generator rules are treated+--   specially in two ways: firstly, they will not be rebuilt if the+--   command line changes; and secondly, they are not cleaned by default.+--+--   @since 0.1.0+{-# INLINE ruleGenerator #-}+ruleGenerator :: Lens.Lens' Rule Bool+ruleGenerator = Lens.lens _ruleGenerator+                $ \(MkRule {..}) x -> MkRule { _ruleGenerator = x, .. }++-- | If true, causes Ninja to re-stat the command's outputs after+--   execution of the command. Each output whose modification time the+--   command did not change will be treated as though it had never needed+--   to be built. This may cause the output's reverse dependencies to be+--   removed from the list of pending build actions.+--+--   @since 0.1.0+{-# INLINE ruleRestat #-}+ruleRestat :: Lens.Lens' Rule Bool+ruleRestat = Lens.lens _ruleRestat+             $ \(MkRule {..}) x -> MkRule { _ruleRestat = x, .. }++-- | If present, Ninja will use a response file for the given command,+--   i.e. write the selected string to the given file before calling the+--   command and delete the file after the command is done.+--+--   This is particularly useful on Windows OS, where the maximal length+--   of a command line is limited and response files must be used instead.+--+--   @since 0.1.0+{-# INLINE ruleResponseFile #-}+ruleResponseFile :: Lens.Lens' Rule (Maybe ResponseFile)+ruleResponseFile = Lens.lens _ruleResponseFile+                   $ \(MkRule {..}) x -> MkRule { _ruleResponseFile = x, .. }++-- | Converts to+--   @{name: …, command: …, desc: …, pool: …, depfile: …,+--     deps: …, generator: …, restat: …, rsp: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Rule where+  toJSON (MkRule {..})+    = [ "name"      .= _ruleName+      , "command"   .= _ruleCommand+      , "desc"      .= _ruleDescription+      , "pool"      .= _rulePool+      , "depfile"   .= _ruleDepfile+      , "deps"      .= _ruleSpecialDeps+      , "generator" .= _ruleGenerator+      , "restat"    .= _ruleRestat+      , "rsp"       .= _ruleResponseFile+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Rule where+  parseJSON = (Aeson.withObject "Rule" $ \o -> do+                  _ruleName         <- (o .: "name")      >>= pure+                  _ruleCommand      <- (o .: "command")   >>= pure+                  _ruleDescription  <- (o .: "desc")      >>= pure+                  _rulePool         <- (o .: "pool")      >>= pure+                  _ruleDepfile      <- (o .: "depfile")   >>= pure+                  _ruleSpecialDeps  <- (o .: "deps")      >>= pure+                  _ruleGenerator    <- (o .: "generator") >>= pure+                  _ruleRestat       <- (o .: "restat")    >>= pure+                  _ruleResponseFile <- (o .: "rsp")       >>= pure+                  pure (MkRule {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Rule++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Rule++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.Serial m Text+         ) => SC.Serial m Rule++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.CoSerial m Text+         ) => SC.CoSerial m Rule++--------------------------------------------------------------------------------++-- | Special dependency information, as described+--   <https://ninja-build.org/manual.html#ref_headers here>.+--+--   @since 0.1.0+data SpecialDeps+  = SpecialDepsGCC+  | SpecialDepsMSVC !Text+  deriving (Eq, Ord, Show, Read, Generic)++-- | Construct a 'SpecialDeps' corresponding to the case in which @deps = gcc@+--   is set in a Ninja build rule.+--+--   @since 0.1.0+{-# INLINE makeSpecialDepsGCC #-}+makeSpecialDepsGCC :: SpecialDeps+makeSpecialDepsGCC = SpecialDepsGCC++-- | Construct a 'SpecialDeps' corresponding to the case in which @deps = msvc@+--   is set and @msvc_deps_prefix = …@.+--+--   The @msvc_deps_prefix@ field defines the string which should be stripped+--   from @msvc@'s @/showIncludes@ output. It is only needed if the version of+--   Visual Studio being used is not English. The value of @msvc_deps_prefix@+--   is @"Note: including file: "@ by default.+--+--   @since 0.1.0+{-# INLINE makeSpecialDepsMSVC #-}+makeSpecialDepsMSVC :: Text+                    -> SpecialDeps+makeSpecialDepsMSVC = SpecialDepsMSVC++-- | A prism for the @deps = gcc@ case.+--+--   @since 0.1.0+{-# INLINE _SpecialDepsGCC #-}+_SpecialDepsGCC :: Lens.Prism' SpecialDeps ()+_SpecialDepsGCC = Lens.prism (const makeSpecialDepsGCC)+                  $ \case SpecialDepsGCC -> Right ()+                          owise          -> Left owise++-- | A prism for the @deps = msvc@ / @msvc_deps_prefix = …@ case.+--+--   @since 0.1.0+{-# INLINE _SpecialDepsMSVC #-}+_SpecialDepsMSVC :: Lens.Prism' SpecialDeps Text+_SpecialDepsMSVC = Lens.prism makeSpecialDepsMSVC+                   $ \case (SpecialDepsMSVC prefix) -> Right prefix+                           owise                    -> Left owise++-- | Converts to @{deps: "gcc"}@ or @{deps: "msvc", prefix: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON SpecialDeps where+  toJSON = go+    where+      go SpecialDepsGCC      = Aeson.object ["deps" .= gcc]+      go (SpecialDepsMSVC p) = Aeson.object ["deps" .= msvc, "prefix" .= p]++      (gcc, msvc) = ("gcc", "msvc") :: (Aeson.Value, Aeson.Value)++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON SpecialDeps where+  parseJSON = Aeson.withObject "SpecialDeps" $ \o -> do+    deps <- o .: "deps"+    case Text.pack deps of+      "gcc"  -> pure SpecialDepsGCC+      "msvc" -> SpecialDepsMSVC <$> (o .: "prefix")+      owise  -> [ "Invalid deps type ", "\"", owise, "\"; "+                , "should be one of [\"gcc\", \"msvc\"]."+                ] |> mconcat |> Text.unpack |> fail++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable SpecialDeps++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData SpecialDeps++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.Serial m Text+         ) => SC.Serial m SpecialDeps++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.CoSerial m Text+         ) => SC.CoSerial m SpecialDeps++--------------------------------------------------------------------------------++-- | A response file to use during rule execution, as documented+--   <https://ninja-build.org/manual.html#ref_rule here>.+--+--   @since 0.1.0+data ResponseFile+  = MkResponseFile+    { _responseFilePath    :: !Path+    , _responseFileContent :: !Text+    }+  deriving (Eq, Ord, Show, Generic)++-- | Construct a 'ResponseFile' with the given 'Path' and content 'Text'.+--+--   @since 0.1.0+{-# INLINE makeResponseFile #-}+makeResponseFile :: Path+                 -- ^ Corresponds to @rspfile@.+                 -> Text+                 -- ^ Corresponds to @rspfile_content@.+                 -> ResponseFile+makeResponseFile = MkResponseFile++-- | A lens for the @rspfile@ field.+--+--   @since 0.1.0+{-# INLINE responseFilePath #-}+responseFilePath :: Lens.Lens' ResponseFile Path+responseFilePath = Lens.lens _responseFilePath+                   $ \(MkResponseFile {..}) x ->+                       MkResponseFile { _responseFilePath = x, .. }++-- | A lens for the @rspfile_content@ field.+--+--   @since 0.1.0+{-# INLINE responseFileContent #-}+responseFileContent :: Lens.Lens' ResponseFile Text+responseFileContent = Lens.lens _responseFileContent+                      $ \(MkResponseFile {..}) x ->+                          MkResponseFile { _responseFileContent = x, .. }++-- | Converts to @{path: …, content: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON ResponseFile where+  toJSON (MkResponseFile {..})+    = [ "path"    .= _responseFilePath+      , "content" .= _responseFileContent+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON ResponseFile where+  parseJSON = Aeson.withObject "ResponseFile"+              $ \o -> MkResponseFile <$> (o .: "path") <*> (o .: "content")++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable ResponseFile++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData ResponseFile++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.Serial m Text+         ) => SC.Serial m ResponseFile++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m+         , SC.CoSerial m Text+         ) => SC.CoSerial m ResponseFile++--------------------------------------------------------------------------------
+ library/Language/Ninja/IR/Target.hs view
@@ -0,0 +1,347 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/IR/Target.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.++{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE UndecidableInstances       #-}++-- |+--   Module      : Language.Ninja.IR.Target+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Types relating to Ninja build targets, outputs, and dependencies.+--+--   @since 0.1.0+module Language.Ninja.IR.Target+  ( -- * @Target@+    Target, makeTarget, targetIText, targetText++    -- * @Output@+  , Output, makeOutput, outputTarget++    -- * @Dependency@+  , Dependency, makeDependency, dependencyTarget, dependencyType+  , DependencyType (..), _NormalDependency, _OrderOnlyDependency+  ) where++import qualified Control.Lens              as Lens++import           Data.Text                 (Text)+import qualified Data.Text                 as Text++import           Data.Aeson                ((.:), (.=))+import qualified Data.Aeson                as Aeson++import           Control.DeepSeq           (NFData)+import           Data.Hashable             (Hashable)+import           Data.String               (IsString)+import           GHC.Generics              (Generic)++import           Test.SmallCheck.Series    ((>>-))+import qualified Test.SmallCheck.Series    as SC++import qualified Language.Ninja.Misc.IText as Misc++import           Flow                      ((.>), (|>))++--------------------------------------------------------------------------------++-- | This type represents a Ninja target name.+--+--   @since 0.1.0+newtype Target+  = MkTarget+    { _targetIText :: Misc.IText+    }+  deriving ( Eq, Ord, Show, Read, IsString, Generic, Hashable, NFData+           , Aeson.ToJSON, Aeson.FromJSON, Aeson.ToJSONKey, Aeson.FromJSONKey )++-- | Construct a 'Target' from some 'Text'.+--+--   @since 0.1.0+{-# INLINE makeTarget #-}+makeTarget :: Text -> Target+makeTarget = Lens.view Misc.itext .> MkTarget++-- | An isomorphism between a 'Target' and its underlying 'IText'.+--+--   @since 0.1.0+{-# INLINE targetIText #-}+targetIText :: Lens.Iso' Target Misc.IText+targetIText = Lens.iso _targetIText MkTarget++-- | An isomorphism that gives access to a 'Text'-typed view of a 'Target',+--   even though the underlying data has type 'IText'.+--+--   This is equivalent to @targetIText . from itext@.+--+--   @since 0.1.0+{-# INLINE targetText #-}+targetText :: Lens.Iso' Target Text+targetText = targetIText . Lens.from Misc.itext++-- | Uses the underlying 'IText' instance.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m Target where+  series = SC.newtypeCons MkTarget++-- | Uses the underlying 'IText' instance.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m Target where+  coseries rs = SC.newtypeAlts rs+                >>- \f -> pure (_targetIText .> f)++--------------------------------------------------------------------------------++-- | A Ninja build output.+--+--   More information is available+--   <https://ninja-build.org/manual.html#ref_outputs here>.+--+--   @since 0.1.0+newtype Output+  = MkOutput+    { _outputTarget :: Target+    }+  deriving (Eq, Ord, Show, Read, Generic)++-- | Construct an 'Output'.+--+--   @since 0.1.0+{-# INLINE makeOutput #-}+makeOutput :: Target+           -- ^ The underlying target.+           -> Output+makeOutput = MkOutput++-- | A lens for the 'Target' of an 'Output'.+--+--   @since 0.1.0+{-# INLINE outputTarget #-}+outputTarget :: Lens.Lens' Output Target+outputTarget = Lens.lens _outputTarget+               $ \(MkOutput {..}) new -> MkOutput { _outputTarget = new, .. }++-- | Converts to @{target: …, type: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Output where+  toJSON (MkOutput {..})+    = [ "target" .= _outputTarget+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Output where+  parseJSON = (Aeson.withObject "Output" $ \o -> do+                  _outputTarget <- (o .: "target") >>= pure+                  pure (MkOutput {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Output++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Output++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m Output++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m Output++--------------------------------------------------------------------------------++-- | A build dependency.+--+--   More information is available+--   <https://ninja-build.org/manual.html#ref_dependencies here>.+--+--   @since 0.1.0+data Dependency+  = MkDependency+    { _dependencyTarget :: !Target+    , _dependencyType   :: !DependencyType+    }+  deriving (Eq, Ord, Show, Read, Generic)++-- | Construct a 'Dependency'.+--+--   @since 0.1.0+{-# INLINE makeDependency #-}+makeDependency :: Target+               -- ^ The underlying target.+               -> DependencyType+               -- ^ The dependency type (normal, implicit, or order-only).+               -> Dependency+makeDependency = MkDependency++-- | A lens for the 'Target' of a 'Dependency'.+--+--   @since 0.1.0+{-# INLINE dependencyTarget #-}+dependencyTarget :: Lens.Lens' Dependency Target+dependencyTarget+  = Lens.lens _dependencyTarget+    $ \(MkDependency {..}) new -> MkDependency { _dependencyTarget = new, .. }++-- | A lens for the 'DependencyType' of a 'Dependency'.+--+--   @since 0.1.0+{-# INLINE dependencyType #-}+dependencyType :: Lens.Lens' Dependency DependencyType+dependencyType+  = Lens.lens _dependencyType+    $ \(MkDependency {..}) new -> MkDependency { _dependencyType = new, .. }++-- | Converts to @{target: …, type: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Dependency where+  toJSON (MkDependency {..})+    = [ "target" .= _dependencyTarget+      , "type"   .= _dependencyType+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Dependency where+  parseJSON = (Aeson.withObject "Dependency" $ \o -> do+                  _dependencyTarget <- (o .: "target") >>= pure+                  _dependencyType   <- (o .: "type")   >>= pure+                  pure (MkDependency {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Dependency++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Dependency++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m Dependency++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m Dependency++--------------------------------------------------------------------------------++-- | The type of a 'Dependency': normal, implicit, or order-only.+--+--   @since 0.1.0+data DependencyType+  = -- | A normal dependency.+    --+    --   @since 0.1.0+    NormalDependency+  | -- | An order-only dependency. These are only rebuilt if there is at least+    --   one non-order-only dependency that is out of date.+    --+    --   Section 4.3 "Types of Prerequisites" in the GNU Make manual has a good+    --   explanation of this concept.+    --+    --   @since 0.1.0+    OrderOnlyDependency+  deriving (Eq, Ord, Show, Read, Generic)++-- | A prism for the 'NormalDependency' constructor.+--+--   @since 0.1.0+{-# INLINE _NormalDependency #-}+_NormalDependency :: Lens.Prism' DependencyType ()+_NormalDependency = Lens.prism' (const NormalDependency)+                    $ \case NormalDependency -> Just ()+                            _                -> Nothing++-- | A prism for the 'OrderOnlyDependency' constructor.+--+--   @since 0.1.0+{-# INLINE _OrderOnlyDependency #-}+_OrderOnlyDependency :: Lens.Prism' DependencyType ()+_OrderOnlyDependency = Lens.prism' (const OrderOnlyDependency)+                       $ \case OrderOnlyDependency -> Just ()+                               _                   -> Nothing++-- | Converts to @"normal"@, @"implicit"@, and @"order-only"@ respectively.+--+--   @since 0.1.0+instance Aeson.ToJSON DependencyType where+  toJSON NormalDependency    = "normal"+  toJSON OrderOnlyDependency = "order-only"++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON DependencyType where+  parseJSON = (Aeson.withText "DependencyType" $ \case+                  "normal"     -> pure NormalDependency+                  "order-only" -> pure OrderOnlyDependency+                  owise        -> [ "Invalid dependency type "+                                  , "\"", owise, "\"; should be one of "+                                  , "[\"normal\", \"order-only\"]"+                                  ] |> mconcat |> Text.unpack |> fail)++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable DependencyType++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData DependencyType++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m) => SC.Serial m DependencyType++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m) => SC.CoSerial m DependencyType++--------------------------------------------------------------------------------
+ library/Language/Ninja/Lexer.hs view
@@ -0,0 +1,405 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Lexer.hs+--+-- License:+--     Copyright Neil Mitchell  2011-2017.+--     Copyright Awake Networks 2017.+--     All rights reserved.+--+--     Redistribution and use in source and binary forms, with or without+--     modification, are permitted provided that the following conditions are+--     met:+--+--         * Redistributions of source code must retain the above copyright+--           notice, this list of conditions and the following disclaimer.+--+--         * Redistributions in binary form must reproduce the above+--           copyright notice, this list of conditions and the following+--           disclaimer in the documentation and/or other materials provided+--           with the distribution.+--+--         * Neither the name of Neil Mitchell nor the names of other+--           contributors may be used to endorse or promote products derived+--           from this software without specific prior written permission.+--+--     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+--     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+--     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+--     A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+--     OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+--     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+--     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+--     DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+--     THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+--     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+--     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}++-- |+--   Module      : Language.Ninja.Lexer+--   Copyright   : Copyright 2011-2017 Neil Mitchell+--   License     : BSD3+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Lexing is a slow point, the code below is optimised.+--+--   @since 0.1.0+module Language.Ninja.Lexer+  ( -- * @lex*IO@+    lexFileIO+  , lexTextIO+  , lexBSIO++    -- * @lex*@+  , lexFile+  , lexText+  , lexBS++    -- * @lex*WithPath@+  , lexTextWithPath+  , lexBSWithPath++    -- * Other ways of running the lexer+  , lexemesP++    -- * Type aliases+  , Lexer.Parser+  , Lexer.Ann++    -- * @Lexeme@ and friends+  , Lexer.Lexeme (..)+  , Lexer.LName  (..)+  , Lexer.LFile  (..)+  , Lexer.LBind  (..)+  , Lexer.LBuild (..), Lexer.makeLBuild++    -- * Classes+  , Lexer.PositionParsing (..)+  ) where++import           Control.Applicative        (Alternative ((<|>)))+import           Control.Arrow              (second)+import           Control.Exception          (throwIO)+import           Control.Monad              (unless, void, (>=>))+import           Control.Monad.Error.Class  (MonadError)+import           Control.Monad.Trans.Except (runExceptT)++import qualified Control.Lens               as Lens++import           Data.ByteString            (ByteString)++import           Data.Text                  (Text)+import qualified Data.Text                  as Text+import qualified Data.Text.Encoding         as Text++import           Data.Char                  (isSpace)+import           Data.Foldable              (asum)+import           Data.Functor               ((<$))+import           Data.Maybe                 (catMaybes, fromMaybe)++import           Flow                       ((.>), (|>))++import qualified Text.Megaparsec            as M+import qualified Text.Megaparsec.Lexer      as M.Lexer++import qualified Language.Ninja.AST         as AST+import qualified Language.Ninja.Errors      as Errors+import qualified Language.Ninja.Lexer.Types as Lexer+import qualified Language.Ninja.Misc        as Misc+import qualified Language.Ninja.Mock        as Mock++--------------------------------------------------------------------------------++-- | Lex the file at the given path.+--   This function may throw an exception if parsing fails.+--+--   @since 0.1.0+lexFileIO :: Misc.Path -> IO [Lexer.Lexeme Lexer.Ann]+lexFileIO = (lexFile .> runExceptT) >=> either throwIO pure++-- | Lex the given 'Text'.+--   This function may throw an exception if parsing fails.+--+--   @since 0.1.0+lexTextIO :: Text -> IO [Lexer.Lexeme Lexer.Ann]+lexTextIO = (lexText .> runExceptT) >=> either throwIO pure++-- | Lex the given 'ByteString'.+--   This function may throw an exception if parsing fails.+--+--   @since 0.1.0+lexBSIO :: ByteString -> IO [Lexer.Lexeme Lexer.Ann]+lexBSIO = (lexBS .> runExceptT) >=> either throwIO pure++--------------------------------------------------------------------------------++-- | Lex the given file.+--+--   @since 0.1.0+lexFile :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+        => Misc.Path -> m [Lexer.Lexeme Lexer.Ann]+lexFile file = Mock.readFile file >>= lexTextWithPath (Just file)++-- | Lex the given 'Text'.+--+--   @since 0.1.0+lexText :: (MonadError Errors.ParseError m)+        => Text -> m [Lexer.Lexeme Lexer.Ann]+lexText = lexTextWithPath Nothing++-- | Lex the given 'BSC8.ByteString'.+--+--   @since 0.1.0+lexBS :: (MonadError Errors.ParseError m)+      => ByteString -> m [Lexer.Lexeme Lexer.Ann]+lexBS = lexBSWithPath Nothing++--------------------------------------------------------------------------------++-- | Lex the given 'Text' that comes from the given 'Misc.Path', if provided.+--+--   @since 0.1.0+lexTextWithPath :: (MonadError Errors.ParseError m)+                => Maybe Misc.Path -> Text -> m [Lexer.Lexeme Lexer.Ann]+lexTextWithPath mp x = M.runParserT lexemesP file x+                       >>= either Errors.throwLexParsecError pure+  where+    file = fromMaybe "" (Lens.view Misc.pathString <$> mp)++-- | Lex the given 'ByteString' that comes from the given 'Misc.Path', if it is+--   provided. The 'Misc.Path' is only used for error messages.+--+--   @since 0.1.0+lexBSWithPath :: (MonadError Errors.ParseError m)+              => Maybe Misc.Path -> ByteString -> m [Lexer.Lexeme Lexer.Ann]+lexBSWithPath mpath = Text.decodeUtf8 .> lexTextWithPath mpath++--------------------------------------------------------------------------------++-- | The @megaparsec@ parser for a Ninja file.+--+--   @since 0.1.0+lexemesP :: Lexer.Parser m [Lexer.Lexeme Lexer.Ann]+lexemesP = do+  maybes <- [ Nothing <$  lineCommentP+            , Nothing <$  M.separatorChar+            , Nothing <$  M.eol+            , Just    <$> (lexemeP <* lineEndP)+            ] |> asum |> M.many+  M.eof+  pure (catMaybes maybes)++--------------------------------------------------------------------------------++lexemeP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+lexemeP = [ includeP, subninjaP, buildP, ruleP, poolP, defaultP, bindP, defineP+          ] |> map M.try |> asum++defineP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+defineP = Lexer.spanned equationP+          |> fmap (uncurry Lexer.LexDefine)+          |> debugP "defineP"++bindP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+bindP = Lexer.spanned (indented f)+        |> fmap (uncurry Lexer.LexBind)+        |> debugP "bindP"+  where+    f :: Misc.Column -> Lexer.Parser m (Lexer.LBind Lexer.Ann)+    f x | x < 2 = fail "bindP: not indented"+    f _         = equationP++includeP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+includeP = debugP "includeP" $ do+  (ann, file) <- Lexer.spanned $ do+    beginningOfLine+    symbolP "include"+    M.Lexer.lexeme spaceP fileP+  pure (Lexer.LexInclude ann file)++subninjaP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+subninjaP = debugP "subninjaP" $ do+  (ann, file) <- Lexer.spanned $ do+    beginningOfLine+    symbolP "subninja"+    M.Lexer.lexeme spaceP fileP+  pure (Lexer.LexSubninja ann file)++buildP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+buildP = debugP "buildP" $ do+  let isExprEmpty :: AST.Expr Lexer.Ann -> Bool+      isExprEmpty (AST.Lit   _ "") = True+      isExprEmpty (AST.Exprs _ []) = True+      isExprEmpty _                = False++  let cleanExprs :: [AST.Expr Lexer.Ann] -> [AST.Expr Lexer.Ann]+      cleanExprs = map AST.normalizeExpr .> filter (isExprEmpty .> not)++  (ann, (outs, rule, deps)) <- Lexer.spanned $ do+    beginningOfLine+    symbolP "build"+    outs <- cleanExprs <$> M.some outputP+    symbolP ":"+    rule <- nameP+    deps <- cleanExprs <$> M.many (M.Lexer.lexeme spaceP exprP)+    pure (outs, rule, deps)++  pure (Lexer.LexBuild ann (Lexer.MkLBuild ann outs rule deps))++ruleP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+ruleP = debugP "ruleP" $ do+  (ann, ruleName) <- Lexer.spanned $ do+    beginningOfLine+    symbolP "rule"+    nameP+  pure (Lexer.LexRule ann ruleName)++poolP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+poolP = debugP "poolP" $ do+  (ann, poolName) <- Lexer.spanned $ do+    beginningOfLine+    symbolP "pool"+    nameP+  pure (Lexer.LexPool ann poolName)++defaultP :: Lexer.Parser m (Lexer.Lexeme Lexer.Ann)+defaultP = debugP "defaultP" $ do+  (ann, defaults) <- Lexer.spanned $ do+    beginningOfLine+    symbolP "default"+    M.many (M.Lexer.lexeme spaceP exprP)+  pure (Lexer.LexDefault ann defaults)++lineEndP :: Lexer.Parser m ()+lineEndP = do+  M.many M.separatorChar+  lineCommentP <|> pure ()+  void M.eol++equationP :: Lexer.Parser m (Lexer.LBind Lexer.Ann)+equationP = debugP "equationP" $ do+  (ann, (name, value)) <- Lexer.spanned $ do+    name <- nameP+    symbolP "="+    value <- exprsP+    pure (name, value)++  pure (Lexer.MkLBind ann name value)++nameP :: Lexer.Parser m (Lexer.LName Lexer.Ann)+nameP = Lexer.spanned varDotP+        |> fmap (second (Text.pack .> Text.encodeUtf8))+        |> fmap (uncurry Lexer.MkLName)+        |> M.Lexer.lexeme spaceP+        |> debugP "nameP"++fileP :: Lexer.Parser m (Lexer.LFile Lexer.Ann)+fileP = Lexer.MkLFile <$> exprP+        |> M.Lexer.lexeme spaceP+        |> debugP "fileP"++outputP :: Lexer.Parser m (AST.Expr Lexer.Ann)+outputP = Lexer.spanned (M.some (dollarP <|> litP))+          |> fmap (uncurry AST.Exprs .> AST.normalizeExpr)+          |> M.Lexer.lexeme spaceP+  where+    litP :: Lexer.Parser m (AST.Expr Lexer.Ann)+    litP = Lexer.spanned (M.some (M.satisfy isOutputChar))+           |> fmap (second Text.pack .> uncurry AST.Lit)++    isOutputChar :: Char -> Bool+    isOutputChar '$'             = False+    isOutputChar ':'             = False+    isOutputChar '\n'            = False+    isOutputChar '\r'            = False+    isOutputChar c   | isSpace c = False+    isOutputChar _               = True++exprsP :: Lexer.Parser m (AST.Expr Lexer.Ann)+exprsP = asum [exprP, separatorP]+         |> M.many+         |> Lexer.spanned+         |> fmap (uncurry AST.Exprs .> AST.normalizeExpr)+  where+    separatorP :: Lexer.Parser m (AST.Expr Lexer.Ann)+    separatorP = Lexer.spanned (M.some M.separatorChar)+                 |> fmap (second Text.pack .> uncurry AST.Lit)++exprP :: Lexer.Parser m (AST.Expr Lexer.Ann)+exprP = Lexer.spanned (M.some (dollarP <|> litP))+        |> fmap (uncurry AST.Exprs .> AST.normalizeExpr)+  where+    litP :: Lexer.Parser m (AST.Expr Lexer.Ann)+    litP = Lexer.spanned (M.some (M.satisfy isExprChar))+           |> fmap (second Text.pack .> uncurry AST.Lit)++    isExprChar :: Char -> Bool+    isExprChar '$'             = False+    isExprChar '\n'            = False+    isExprChar '\r'            = False+    isExprChar c   | isSpace c = False+    isExprChar _               = True++dollarP :: Lexer.Parser m (AST.Expr Lexer.Ann)+dollarP = debugP "dollarP"+          (M.char '$'+           *> ([ makeLit (M.string "$")+               , makeLit (M.string " ")+               , makeLit (M.string ":")+               , makeLit ((M.eol *> M.many M.separatorChar *> pure ""))+               , makeVar ((M.char '{' *> varDotP <* M.char '}'))+               , makeVar varP+               ] |> asum))+  where+    makeLit :: Lexer.Parser m String -> Lexer.Parser m (AST.Expr Lexer.Ann)+    makeLit p = Lexer.spanned p |> fmap (second Text.pack .> uncurry AST.Lit)++    makeVar :: Lexer.Parser m String -> Lexer.Parser m (AST.Expr Lexer.Ann)+    makeVar p = Lexer.spanned p |> fmap (second Text.pack .> uncurry AST.Var)++varDotP :: Lexer.Parser m String+varDotP = M.some (M.alphaNumChar <|> M.oneOf ['/', '-', '_', '.'])+          |> debugP "varDotP"++varP :: Lexer.Parser m String+varP = M.some (M.alphaNumChar <|> M.oneOf ['/', '-', '_'])+       |> debugP "varP"++symbolP :: String -> Lexer.Parser m String+symbolP = M.Lexer.symbol spaceP++spaceP :: Lexer.Parser m ()+spaceP = M.Lexer.space (void M.separatorChar) lineCommentP blockCommentP++lineCommentP :: Lexer.Parser m ()+lineCommentP = M.Lexer.skipLineComment "#"++blockCommentP :: Lexer.Parser m ()+blockCommentP = fail "always"++indented :: (Misc.Column -> Lexer.Parser m a) -> Lexer.Parser m a+indented f = do+  M.many M.separatorChar+  Lexer.getPosition >>= Lens.view Misc.positionCol .> f++beginningOfLine :: Lexer.Parser m ()+beginningOfLine = do+  col <- Lens.view Misc.positionCol <$> Lexer.getPosition+  unless (col == 1) (fail "beginningOfLine failed")++debugP :: (Show a) => String -> Lexer.Parser m a -> Lexer.Parser m a+debugP str p = M.label str p -- M.dbg str p+  where+    -- this shuts up the compiler wrt the Show constraint+    _ = show <$> p++--------------------------------------------------------------------------------
+ library/Language/Ninja/Lexer/Types.hs view
@@ -0,0 +1,585 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Lexer/Types.hs+--+-- License:+--     Copyright Neil Mitchell  2011-2017.+--     Copyright Awake Networks 2017.+--     All rights reserved.+--+--     Redistribution and use in source and binary forms, with or without+--     modification, are permitted provided that the following conditions are+--     met:+--+--         * Redistributions of source code must retain the above copyright+--           notice, this list of conditions and the following disclaimer.+--+--         * Redistributions in binary form must reproduce the above+--           copyright notice, this list of conditions and the following+--           disclaimer in the documentation and/or other materials provided+--           with the distribution.+--+--         * Neither the name of Neil Mitchell nor the names of other+--           contributors may be used to endorse or promote products derived+--           from this software without specific prior written permission.+--+--     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+--     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+--     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+--     A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+--     OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+--     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+--     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+--     DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+--     THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+--     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+--     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE UndecidableInstances       #-}++-- |+--   Module      : Language.Ninja.Lexer+--   Copyright   : Copyright 2011-2017 Neil Mitchell+--   License     : BSD3+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Lexing is a slow point, the code below is optimised.+--+--   @since 0.1.0+module Language.Ninja.Lexer.Types+  ( -- * Type aliases+    Parser, Ann++    -- * @Lexeme@ and friends+  , Lexeme (..)+  , LName  (..)+  , LFile  (..)+  , LBind  (..)+  , LBuild (..), makeLBuild++  , LexemeConstraint+  , LNameConstraint+  , LFileConstraint+  , LBindConstraint+  , LBuildConstraint++    -- * @PositionParsing@+  , PositionParsing (..)+  , spanned+  ) where++import           Control.Arrow          (second)+import           Control.Monad          (when)++import qualified Control.Lens           as Lens++import           Data.ByteString        (ByteString)++import           Data.Text              (Text)+import qualified Data.Text              as Text+import qualified Data.Text.Encoding     as Text++import           Flow                   ((.>), (|>))++import qualified Text.Megaparsec        as M++import           Data.Aeson             ((.:), (.=))+import qualified Data.Aeson             as Aeson+import qualified Data.Aeson.Types       as Aeson++import           Control.DeepSeq        (NFData)+import           Data.Hashable          (Hashable)+import           GHC.Generics           (Generic)++import           Test.SmallCheck.Series ((<~>))+import qualified Test.SmallCheck.Series as SC++import           GHC.Exts               (Constraint)++import qualified Language.Ninja.AST     as AST+import qualified Language.Ninja.Misc    as Misc++--------------------------------------------------------------------------------++-- | A @megaparsec@ parser.+--+--   @since 0.1.0+type Parser m a = M.ParsecT M.Dec Text m a++-- | The type of annotations returned by the lexer.+--+--   @since 0.1.0+type Ann = Misc.Spans++--------------------------------------------------------------------------------++-- | This class is kind of like 'DeltaParsing' from @trifecta@.+--+--   @since 0.1.0+class (Monad m) => PositionParsing m where+  getPosition :: m Misc.Position++-- | Instance for 'M.ParsecT' from @megaparsec@.+--+--   @since 0.1.0+instance PositionParsing (M.ParsecT M.Dec Text m) where+  getPosition = convert <$> M.getPosition+    where+      convert :: M.SourcePos -> Misc.Position+      convert (M.SourcePos fp line column)+        = let path = Lens.view (Lens.from Misc.pathString) fp+          in Misc.makePosition (Just path) (toLine line, toColumn column)++      toLine   :: M.Pos -> Misc.Line+      toColumn :: M.Pos -> Misc.Column+      toLine   = M.unPos .> fromIntegral+      toColumn = M.unPos .> fromIntegral++-- | Surround a section of parsers in 'getPosition' calls and return the+--   associated 'Misc.Spans'. Note that if a call of this function wraps over+--   a parser that somehow goes over multiple files, it will 'fail'.+--+--   @since 0.1.0+spanned :: (PositionParsing m) => m a -> m (Misc.Spans, a)+spanned p = do+  start  <- getPosition+  result <- p+  end    <- getPosition+  let getPosFile :: Misc.Position -> Maybe Misc.Path+      getPosFile = Lens.view Misc.positionFile+  let (sfile, efile) = (getPosFile start, getPosFile end)+  when (sfile /= efile) $ fail "spanned: somehow went over multiple files!"+  let file = sfile+  let offS = Lens.view Misc.positionOffset start+  let offE = Lens.view Misc.positionOffset end+  pure (Misc.makeSpans [Misc.makeSpan file offS offE], result)++--------------------------------------------------------------------------------++-- | Lex each line separately, rather than each lexeme.+--+--   @since 0.1.0+data Lexeme ann+  = -- | @foo = bar@+    --+    --   @since 0.1.0+    LexDefine   !ann !(LBind ann)+  | -- | @[indent]foo = bar@+    --+    --   @since 0.1.0+    LexBind     !ann !(LBind ann)+  | -- | @include file@+    --+    --   @since 0.1.0+    LexInclude  !ann !(LFile ann)+  | -- | @subninja file@+    --+    --   @since 0.1.0+    LexSubninja !ann !(LFile ann)+  | -- | @build foo: bar | baz || qux@+    --+    --   @since 0.1.0+    LexBuild    !ann !(LBuild ann)+  | -- | @rule name@+    --+    --   @since 0.1.0+    LexRule     !ann !(LName ann)+  | -- | @pool name@+    --+    --   @since 0.1.0+    LexPool     !ann !(LName ann)+  | -- | @default foo bar@+    --+    --   @since 0.1.0+    LexDefault  !ann ![AST.Expr ann]+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated Lexeme where+  annotation' f = Lens.lens (helper .> fst) (helper .> snd)+    where+      helper (LexDefine   ann v) = (ann, \x -> LexDefine   x (f <$> v))+      helper (LexBind     ann v) = (ann, \x -> LexBind     x (f <$> v))+      helper (LexInclude  ann v) = (ann, \x -> LexInclude  x (f <$> v))+      helper (LexSubninja ann v) = (ann, \x -> LexSubninja x (f <$> v))+      helper (LexBuild    ann v) = (ann, \x -> LexBuild    x (f <$> v))+      helper (LexRule     ann v) = (ann, \x -> LexRule     x (f <$> v))+      helper (LexPool     ann v) = (ann, \x -> LexPool     x (f <$> v))+      helper (LexDefault  ann v) = (ann, \x -> LexDefault  x (map (fmap f) v))++-- | Converts to @{ann: …, tag: …, value: …}@.+--+--   @since 0.1.0+instance forall ann. (Aeson.ToJSON ann) => Aeson.ToJSON (Lexeme ann) where+  toJSON = (\case (LexDefine   ann value) -> obj ann "define"   value+                  (LexBind     ann value) -> obj ann "bind"     value+                  (LexInclude  ann value) -> obj ann "include"  value+                  (LexSubninja ann value) -> obj ann "subninja" value+                  (LexBuild    ann value) -> obj ann "build"    value+                  (LexRule     ann value) -> obj ann "rule"     value+                  (LexPool     ann value) -> obj ann "pool"     value+                  (LexDefault  ann value) -> obj ann "default"  value)+    where+      obj :: forall x. (Aeson.ToJSON x) => ann -> Text -> x -> Aeson.Value+      obj ann tag value = [ "ann" .= ann, "tag" .= tag, "value" .= value+                          ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (Lexeme ann) where+  parseJSON = (Aeson.withObject "Lexeme" $ \o -> do+                  ann <- o .: "ann"+                  tag <- o .: "tag"+                  case (tag :: Text) of+                    "define"   -> LexDefine   ann <$> (o .: "value")+                    "bind"     -> LexBind     ann <$> (o .: "value")+                    "include"  -> LexInclude  ann <$> (o .: "value")+                    "subninja" -> LexSubninja ann <$> (o .: "value")+                    "build"    -> LexBuild    ann <$> (o .: "value")+                    "rule"     -> LexRule     ann <$> (o .: "value")+                    "pool"     -> LexPool     ann <$> (o .: "value")+                    "default"  -> LexDefault  ann <$> (o .: "value")+                    owise      -> invalidTagError (Text.unpack owise))+    where+      invalidTagError :: String -> Aeson.Parser a+      invalidTagError x = [ "Invalid tag: ", x, "; expected one of: "+                          , show validTags+                          ] |> mconcat |> fail++      validTags :: [Text]+      validTags = [ "define", "bind", "include", "subninja"+                  , "build", "rule", "pool", "default" ]++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (Lexeme ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (Lexeme ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LexemeConstraint (SC.Serial m) ann+         ) => SC.Serial m (Lexeme ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LexemeConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (Lexeme ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for an 'Lexeme'.+--+--   @since 0.1.0+type LexemeConstraint (c :: * -> Constraint) (ann :: *)+  = ( LBindConstraint  c ann+    , LFileConstraint  c ann+    , LBuildConstraint c ann+    , LNameConstraint  c ann+    , c [AST.Expr ann]+    , c ann+    )++--------------------------------------------------------------------------------++-- | The name of a Ninja rule or pool.+--+--   @since 0.1.0+data LName ann+  = MkLName+    { _lnameAnn :: !ann+    , _lnameBS  :: !ByteString+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated LName where+  annotation' _ = Lens.lens _lnameAnn+                  $ \(MkLName {..}) x -> MkLName { _lnameAnn = x, .. }++-- | Converts to @{ann: …, name: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (LName ann) where+  toJSON (MkLName {..})+    = [ "ann"  .= _lnameAnn+      , "name" .= Text.decodeUtf8 _lnameBS+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (LName ann) where+  parseJSON = (Aeson.withObject "LName" $ \o -> do+                  _lnameAnn <- (o .: "ann")  >>= pure+                  _lnameBS  <- (o .: "name") >>= Text.encodeUtf8 .> pure+                  pure (MkLName {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (LName ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (LName ann)++-- | Uses the underlying 'SC.Serial' instances.+--+--   @since 0.1.0+instance ( Monad m, LNameConstraint (SC.Serial m) ann+         ) => SC.Serial m (LName ann) where+  series = SC.series |> fmap (second Text.encodeUtf8 .> uncurry MkLName)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LNameConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (LName ann) where+  coseries = SC.coseries .> fmap (\f -> _lnameBS .> Text.decodeUtf8 .> f)++-- | The set of constraints required for a given constraint to be automatically+--   computed for an 'LName'.+--+--   @since 0.1.0+type LNameConstraint (c :: * -> Constraint) (ann :: *) = (c Text, c ann)++--------------------------------------------------------------------------------++-- | A reference to a file in an @include@ or @subninja@ declaration.+--+--   @since 0.1.0+newtype LFile ann+  = MkLFile+    { _lfileExpr :: AST.Expr ann+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Converts to @{file: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (LFile ann) where+  toJSON (MkLFile {..})+    = [ "file" .= _lfileExpr+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (LFile ann) where+  parseJSON = (Aeson.withObject "LFile" $ \o -> do+                  _lfileExpr <- (o .: "file")  >>= pure+                  pure (MkLFile {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (LFile ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (LFile ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LFileConstraint (SC.Serial m) ann+         ) => SC.Serial m (LFile ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LFileConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (LFile ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for an 'LFile'.+--+--   @since 0.1.0+type LFileConstraint (c :: * -> Constraint) (ann :: *) = (c Text, c ann)++--------------------------------------------------------------------------------++-- | A Ninja variable binding, top-level or otherwise.+--+--   @since 0.1.0+data LBind ann+  = MkLBind+    { _lbindAnn   :: !ann+    , _lbindName  :: !(LName ann)+    , _lbindValue :: !(AST.Expr ann)+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Converts to @{ann: …, name: …, value: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (LBind ann) where+  toJSON (MkLBind {..})+    = [ "ann"   .= _lbindAnn+      , "name"  .= _lbindName+      , "value" .= _lbindValue+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (LBind ann) where+  parseJSON = (Aeson.withObject "LBind" $ \o -> do+                  _lbindAnn   <- (o .: "ann")   >>= pure+                  _lbindName  <- (o .: "name")  >>= pure+                  _lbindValue <- (o .: "value") >>= pure+                  pure (MkLBind {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (LBind ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (LBind ann)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LBindConstraint (SC.Serial m) ann+         ) => SC.Serial m (LBind ann)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LBindConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (LBind ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for an 'LBind'.+--+--   @since 0.1.0+type LBindConstraint (c :: * -> Constraint) (ann :: *) = (c Text, c ann)++--------------------------------------------------------------------------------++-- | The data contained within a Ninja @build@ declaration.+--+--   @since 0.1.0+data LBuild ann+  = MkLBuild+    { _lbuildAnn  :: !ann+    , _lbuildOuts :: ![AST.Expr ann]+    , _lbuildRule :: !(LName ann)+    , _lbuildDeps :: ![AST.Expr ann]+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Constructor for an 'LBuild'.+--+--   @since 0.1.0+makeLBuild :: forall ann.+              ann+           -- ^ The build annotation+           -> [AST.Expr ann]+           -- ^ The build outputs+           -> LName ann+           -- ^ The rule name+           -> [AST.Expr ann]+           -- ^ The build dependencies+           -> LBuild ann+makeLBuild ann outs rule deps+  = let filterExprs :: [AST.Expr ann] -> [AST.Expr ann]+        filterExprs = filter (\case (AST.Lit   _ "") -> False+                                    (AST.Exprs _ []) -> False+                                    _                -> True)+    in MkLBuild ann (filterExprs outs) rule (filterExprs deps)++-- | The usual definition for 'Misc.Annotated'.+--+--   @since 0.1.0+instance Misc.Annotated LBuild where+  annotation' f = Lens.lens _lbuildAnn+                  $ \(MkLBuild {..}) x ->+                      MkLBuild { _lbuildAnn = x+                               , _lbuildOuts = map (fmap f) _lbuildOuts+                               , _lbuildRule = f <$> _lbuildRule+                               , _lbuildDeps = map (fmap f) _lbuildOuts+                               , .. }++-- | Converts to @{ann: …, outs: …, rule: …, deps: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON ann) => Aeson.ToJSON (LBuild ann) where+  toJSON (MkLBuild {..})+    = [ "ann"  .= _lbuildAnn+      , "outs" .= _lbuildOuts+      , "rule" .= _lbuildRule+      , "deps" .= _lbuildDeps+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON ann) => Aeson.FromJSON (LBuild ann) where+  parseJSON = (Aeson.withObject "LBuild" $ \o -> do+                  _lbuildAnn  <- (o .: "ann")  >>= pure+                  _lbuildOuts <- (o .: "outs") >>= pure+                  _lbuildRule <- (o .: "rule") >>= pure+                  _lbuildDeps <- (o .: "deps") >>= pure+                  pure (MkLBuild {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable ann) => Hashable (LBuild ann)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData ann) => NFData (LBuild ann)++-- | Uses the underlying 'SC.Serial' instances.+--+--   @since 0.1.0+instance ( Monad m, LBuildConstraint (SC.Serial m) ann+         ) => SC.Serial m (LBuild ann) where+  series = makeLBuild <$> SC.series <~> SC.series <~> SC.series <~> SC.series++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, LBuildConstraint (SC.CoSerial m) ann+         ) => SC.CoSerial m (LBuild ann)++-- | The set of constraints required for a given constraint to be automatically+--   computed for an 'LBuild'.+--+--   @since 0.1.0+type LBuildConstraint (c :: * -> Constraint) (ann :: *) = (c Text, c ann)++--------------------------------------------------------------------------------
+ library/Language/Ninja/Misc.hs view
@@ -0,0 +1,81 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Misc.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-missing-import-lists #-}++-- |+--   Module      : Language.Ninja.Misc+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Utility types and functions for the rest of @language-ninja@.+--+--   This module re-exports all of the modules under the "Language.Ninja.Misc"+--   namespace for convenience.+--+--   It is recommended that you import it with the following style:+--+--   > import qualified Language.Ninja.Misc as Misc+--+--   @since 0.1.0+module Language.Ninja.Misc+  ( -- * "Language.Ninja.Misc.Command"+    Misc.Command, Misc.makeCommand+  , Misc.commandText++    -- * "Language.Ninja.Misc.Path"+  , Misc.Path, Misc.makePath+  , Misc.pathIText, Misc.pathText, Misc.pathString, Misc.pathFP++    -- * "Language.Ninja.Misc.IText"+  , Misc.IText, Misc.uninternText, Misc.internText, Misc.itext++    -- * "Language.Ninja.Misc.Positive"+  , Misc.Positive, Misc.makePositive, Misc.fromPositive++    -- * "Language.Ninja.Misc.Annotated"+  , Misc.Annotated (..), Misc.annotation++    -- * "Language.Ninja.Misc.Located"+  , Misc.Located, Misc.tokenize, Misc.tokenizeFile, Misc.tokenizeText+  , Misc.locatedPos, Misc.locatedVal++  , Misc.Spans, Misc.makeSpans+  , Misc.spansSet++  , Misc.Span, Misc.makeSpan+  , Misc.spanPath, Misc.spanRange, Misc.spanStart, Misc.spanEnd++  , Misc.Position, Misc.makePosition+  , Misc.positionFile, Misc.positionOffset, Misc.positionLine, Misc.positionCol+  , Misc.comparePosition++  , Misc.Offset+  , Misc.compareOffset, Misc.offsetLine, Misc.offsetColumn+  , Misc.Line, Misc.Column+  ) where++import qualified Language.Ninja.Misc.Annotated as Misc+import qualified Language.Ninja.Misc.Command   as Misc+import qualified Language.Ninja.Misc.IText     as Misc+import qualified Language.Ninja.Misc.Located   as Misc+import qualified Language.Ninja.Misc.Path      as Misc+import qualified Language.Ninja.Misc.Positive  as Misc
+ library/Language/Ninja/Misc/Annotated.hs view
@@ -0,0 +1,94 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Misc/Annotated.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.++{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes     #-}++-- |+--   Module      : Language.Ninja.Misc.Annotated+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A typeclass for AST nodes that are annotated with a polymorphic field,+--   which provides a canonical lens into that field.+--+--   @since 0.1.0+module Language.Ninja.Misc.Annotated+  ( Annotated (..), annotation+  ) where++import qualified Control.Lens as Lens++--------------------------------------------------------------------------------++-- | If you have some type that represents an AST node, it is often useful to+--   add a polymorphic "annotation field" to it, which is used for things like+--   source positions.+--+--   Specifically, suppose we have the following AST node type:+--+--   @data Foo = Foo { _fooBar :: !Bar, _fooBaz :: !Baz } deriving (…)@+--+--   Then an annotation field is added by the following process:+--+--   1. Add an extra (final) type parameter @ann@ to the type.+--   2. Add an extra field @_fooAnn :: !ann@.+--   3. Derive instances of 'Functor', 'Foldable', and 'Traversable'.+--   4. If the type is recursive, add a 'Lens.Plated' instance.+--      See "Language.Ninja.AST.Expr" for a complete example of this.+--   5. Write an 'Annotated' instance with the canonical lens given by the+--      @_fooAnn@ field. There are plenty of examples around this library.+--+--   The end result then looks like:+--+--   > data Foo ann+--   >   = Foo+--   >     { _fooAnn :: !ann+--   >     , _fooBar :: !Bar+--   >     , _fooBaz :: !Baz+--   >     }+--   >   deriving (…, Functor, Foldable, Traversable)+--   >+--   > instance Annotated Foo where+--   >   annotation' = …+--+--   @since 0.1.0+class (Functor ty) => Annotated (ty :: * -> *) where+  -- | Given a function that is used when 'fmap'ing any subterms, return a lens+  --   into the "annotation" field.+  --+  --   When writing an instance, keep in mind that @'annotation'' id@ should+  --   just be the typical definition for a lens into the annotation field.+  --+  --   It should also be true that for any @f :: B -> C@ and @g :: A -> B@,+  --+  --   > annotation' (f . g) == annotation' f . annotation' g+  --+  --   @since 0.1.0+  annotation' :: (ann -> ann') -> Lens.Lens (ty ann) (ty ann') ann ann'++-- | This is just shorthand for @'annotation'' id@.+--+--   @since 0.1.0+annotation :: (Annotated ty) => Lens.Lens' (ty ann) ann+annotation = annotation' id++--------------------------------------------------------------------------------
+ library/Language/Ninja/Misc/Command.hs view
@@ -0,0 +1,99 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Misc/Command.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.++{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE UndecidableInstances       #-}++-- |+--   Module      : Language.Ninja.Misc.Command+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A datatype representing a POSIX @sh@ command line.+--+--   @since 0.1.0+module Language.Ninja.Misc.Command+  ( Command, makeCommand, commandText+  ) where++import           Data.Text              (Text)++import qualified Data.Aeson             as Aeson++import           Control.DeepSeq        (NFData)+import           Data.Hashable          (Hashable)+import           GHC.Generics           (Generic)++import           Test.SmallCheck.Series ((>>-))+import qualified Test.SmallCheck.Series as SC++import qualified Control.Lens           as Lens++import           Flow                   ((.>))++--------------------------------------------------------------------------------++-- | This type represents a POSIX @sh@ command line.+--+--   @since 0.1.0+newtype Command+  = MkCommand+    { _commandText :: Text+    }+  deriving ( Eq, Ord, Show, Read, Generic, Hashable, NFData+           , Aeson.ToJSON, Aeson.FromJSON )++-- | Constructor for a 'Command'.+--+--   @since 0.1.0+{-# INLINE makeCommand #-}+makeCommand :: Text -> Command+makeCommand = MkCommand++-- | An isomorphism between a 'Command' and its underlying 'Text'.+--+--   @since 0.1.0+{-# INLINE commandText #-}+commandText :: Lens.Iso' Command Text+commandText = Lens.iso _commandText MkCommand++-- | Uses the underlying 'Text' instance.+--+--   @since 0.1.0+instance ( Monad m+         , SC.Serial m Text+         ) => SC.Serial m Command where+  series = SC.newtypeCons MkCommand++-- | Uses the underlying 'Text' instance.+--+--   @since 0.1.0+instance ( Monad m+         , SC.CoSerial m Text+         ) => SC.CoSerial m Command where+  coseries rs = SC.newtypeAlts rs+                >>- \f -> pure (_commandText .> f)++--------------------------------------------------------------------------------
+ library/Language/Ninja/Misc/IText.hs view
@@ -0,0 +1,181 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Misc/IText.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.++{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE UndecidableInstances       #-}++-- |+--   Module      : Language.Ninja.Misc.IText+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   An interned text type.+--+--   @since 0.1.0+module Language.Ninja.Misc.IText+  ( IText, uninternText, internText, itext+  ) where++import qualified Control.Lens           as Lens++import           Data.Text              (Text)+import qualified Data.Text              as Text++import qualified Data.Aeson             as Aeson+import qualified Data.Aeson.Types       as Aeson++import qualified Data.Interned          as Interned+import qualified Data.Interned.Text     as Interned (InternedText)++import           Control.DeepSeq        (NFData (rnf))+import           Data.Hashable          (Hashable (hashWithSalt))+import           Data.String            (IsString (fromString))+import           GHC.Generics           (Generic)++import qualified Test.SmallCheck.Series as SC++import           Control.Arrow          (first)+import           Flow                   ((.>), (|>))++--------------------------------------------------------------------------------++-- | An interned (hash-consed) text type.+--   This is a newtype over 'Interned.InternedText' from the @intern@ package.+--+--   @since 0.1.0+newtype IText+  = MkIText Interned.InternedText+  deriving (Eq, IsString, Generic)++-- | Get the 'Text' corresponding to the given 'IText' value.+--+--   >>> uninternText ("foobar" :: IText)+--   "foobar"+--+--   @since 0.1.0+{-# INLINE uninternText #-}+uninternText :: IText -> Text+uninternText (MkIText i) = Interned.unintern i++-- | Intern a 'Text' value, resulting in an 'IText' value.+--+--   prop> uninternText (internText (Text.pack x)) == Text.pack x+--+--   >>> internText ("foobar" :: Text)+--   "foobar"+--+--   @since 0.1.0+{-# INLINE internText #-}+internText :: Text -> IText+internText = Interned.intern .> MkIText++-- | An 'Lens.Iso'' between 'Text' and 'IText'.+--+--   prop> (Lens.view itext (fromString x)) == fromString x+--+--   prop> (Lens.view (Lens.from itext) (fromString x)) == fromString x+--+--   >>> (Lens.view itext ("foobar" :: Text)) :: IText+--   "foobar"+--+--   >>> (Lens.view (Lens.from itext) ("foobar" :: IText)) :: Text+--   "foobar"+--+--   @since 0.1.0+{-# INLINE itext #-}+itext :: Lens.Iso' Text IText+itext = Lens.iso internText uninternText++-- | The 'Ord' instance in @intern@ compares hashes rather than values.+--+--   @since 0.1.0+instance Ord IText where+  compare itA itB = compare (uninternText itA) (uninternText itB)++-- | Displays an 'IText' such that 'fromString' is inverse to 'show'.+--+--   @since 0.1.0+instance Show IText where+  show (MkIText i) = show i++-- | Inverse of the 'Show' instance.+--+--   @since 0.1.0+instance Read IText where+  readsPrec i = readsPrec i .> map (first (fromString .> MkIText))++-- | Uses the 'Hashable' instance for 'Text'. Not very efficient.+--+--   TODO: perhaps switch to hashing the identifier, since this is likely+--   pretty hot code given all the @HashMap Target …@ types all over the place.+--+--   @since 0.1.0+instance Hashable IText where+  hashWithSalt n = uninternText .> hashWithSalt n++-- | Defined by @rnf a = seq a ()@, since 'IText' is a newtype of strict types.+--+--   @since 0.1.0+instance NFData IText where+  rnf a = seq a ()++-- | Converts to JSON string via 'uninternText'.+--+--   @since 0.1.0+instance Aeson.ToJSON IText where+  toJSON = uninternText .> Aeson.toJSON++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON IText where+  parseJSON = Aeson.withText "IText" (internText .> pure)++-- | Converts to JSON string via 'uninternText'.+--+--   @since 0.1.0+instance Aeson.ToJSONKey IText where+  toJSONKey = Aeson.toJSONKeyText uninternText++-- | Inverse of the 'Aeson.ToJSONKey' instance.+--+--   @since 0.1.0+instance Aeson.FromJSONKey IText where+  fromJSONKey = Aeson.mapFromJSONKeyFunction internText Aeson.fromJSONKey++-- | Uses the 'Text' instance.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m IText where+  series = SC.series |> fmap (Text.unpack .> Text.pack .> internText)++-- | Uses the 'Text' instance.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m IText where+  coseries = SC.coseries .> fmap (\f int -> f (uninternText int))++--------------------------------------------------------------------------------
+ library/Language/Ninja/Misc/Located.hs view
@@ -0,0 +1,590 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Misc/Located.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.++{-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE UndecidableInstances       #-}++-- |+--   Module      : Language.Ninja.Misc.Located+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Tokenize text into a list of non-whitespace chunks, each of which is+--   annotated with its source location.+--+--   @since 0.1.0+module Language.Ninja.Misc.Located+  ( -- * @Located@+    Located+  , tokenize, tokenizeFile, tokenizeText+  -- , untokenize+  , locatedPos, locatedVal++    -- * @Spans@+  , Spans, makeSpans, spansSet++    -- * @Span@+  , Span, makeSpan, spanPath, spanRange+  , spanStart, spanEnd, spanStartPos, spanEndPos++    -- * @Position@+  , Position, makePosition+  , positionFile, positionOffset, positionLine, positionCol+  , comparePosition++    -- * @Offset@+  , Offset, compareOffset, offsetLine, offsetColumn++    -- * Miscellaneous+  , Line, Column+  ) where++import           Control.Arrow            (second, (&&&), (***))++import qualified Control.Lens             as Lens++import           Control.Monad.ST         (ST)+import qualified Control.Monad.ST         as ST+import           Data.STRef               (STRef)+import qualified Data.STRef               as ST++import           Data.Char                (isSpace)+import qualified Data.Maybe+import           Data.Semigroup           (Semigroup ((<>)))++import           Data.Text                (Text)+import qualified Data.Text                as Text++import           Data.HashSet             (HashSet)+import qualified Data.HashSet             as HS++import           Control.DeepSeq          (NFData)+import           Data.Hashable            (Hashable)+import           GHC.Generics             (Generic)++import qualified Test.SmallCheck.Series   as SC++import           Data.Aeson               ((.:), (.=))+import qualified Data.Aeson               as Aeson+import qualified Data.Aeson.Types         as Aeson++import           Flow                     ((.>), (|>))++import qualified Language.Ninja.Misc.Path as Misc+import qualified Language.Ninja.Mock      as Mock++--------------------------------------------------------------------------------++-- | This datatype represents a value annotated with a source location.+--+--   @since 0.1.0+data Located t+  = MkLocated+    { _locatedPos :: {-# UNPACK #-} !Position+    , _locatedVal ::                !t+    }+  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Construct a 'Located' value directly.+--+--   @since 0.1.0+{-# INLINE makeLocated #-}+makeLocated :: Position -> t -> Located t+makeLocated = MkLocated++-- | Given @path :: 'Maybe' 'Misc.Path'@ and a @text :: 'Text'@, do the+--   following:+--+--   * Remove all @'\r'@ characters from the @text@.+--   * Split the @text@ into chunks that are guaranteed not to contain newlines+--     or whitespace, and which are annotated with their location.+--+--   @since 0.1.0+tokenize :: Maybe Misc.Path -> Text -> [Located Text]+tokenize mpath = removeWhitespace (mpath, 0, 0)++-- | Read the file at the given 'Misc.Path' and then run 'tokenize' on the+--   resulting 'Text'.+--+--   @since 0.1.0+tokenizeFile :: (Mock.MonadReadFile m) => Misc.Path -> m [Located Text]+tokenizeFile path = tokenize (Just path) <$> Mock.readFile path++-- | This function is equivalent to @tokenize Nothing@.+--+--   @since 0.1.0+tokenizeText :: Text -> [Located Text]+tokenizeText = tokenize Nothing++-- TODO: uncomment this and implement it+--+-- -- | This function takes the output of 'tokenize' and returns a map from+-- --   paths to the contents of the associated files.+-- --+-- --   prop> untokenize [] == mempty+-- --   prop> untokenize (xs <> ys) == untokenize xs <> untokenize ys+-- --   prop> untokenize (tokenize (Just path) t) == Map.singleton path t+-- --+-- --   @since 0.1.0+-- untokenize :: [Located Text] -> Map Misc.Path Text+-- untokenize = error "untokenize is not yet written"++-- | The position of this located value.+--+--   @since 0.1.0+{-# INLINE locatedPos #-}+locatedPos :: Lens.Lens' (Located t) Position+locatedPos = Lens.lens _locatedPos+             $ \(MkLocated {..}) x -> MkLocated { _locatedPos = x, .. }++-- | The value underlying this located value.+--+--   @since 0.1.0+{-# INLINE locatedVal #-}+locatedVal :: Lens.Lens' (Located t) t+locatedVal = Lens.lens _locatedVal+             $ \(MkLocated {..}) x -> MkLocated { _locatedVal = x, .. }++-- | Converts to @{position: …, value: …}@.+--+--   @since 0.1.0+instance (Aeson.ToJSON t) => Aeson.ToJSON (Located t) where+  toJSON (MkLocated {..})+    = [ "pos" .= _locatedPos+      , "val" .= _locatedVal+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance (Aeson.FromJSON t) => Aeson.FromJSON (Located t) where+  parseJSON = (Aeson.withObject "Located" $ \o -> do+                  _locatedPos <- (o .: "pos") >>= pure+                  _locatedVal <- (o .: "val") >>= pure+                  pure (MkLocated {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance (Hashable t) => Hashable (Located t)++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance (NFData t) => NFData (Located t)++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, SC.Serial m Text, SC.Serial m t+         ) => SC.Serial m (Located t)++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance ( Monad m, SC.CoSerial m Text, SC.CoSerial m t+         ) => SC.CoSerial m (Located t)++--------------------------------------------------------------------------------++-- | A type representing a set of source spans.+--+--   @since 0.1.0+newtype Spans+  = MkSpans (HashSet Span)+  deriving ( Eq, Show, Semigroup, Monoid+           , Generic, Aeson.ToJSON, Aeson.FromJSON+           , Hashable, NFData )++-- | Construct a 'Spans' from a list of 'Span's.+--+--   @since 0.1.0+{-# INLINE makeSpans #-}+makeSpans :: [Span] -> Spans+makeSpans = HS.fromList .> MkSpans++-- | A lens into the @'HashSet' 'Span'@ underlying a value of type 'Spans'.+--+--   @since 0.1.0+{-# INLINE spansSet #-}+spansSet :: Lens.Iso' Spans (HashSet Span)+spansSet = Lens.iso (\(MkSpans s) -> s) MkSpans++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m (HashSet Span)) => SC.Serial m Spans++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m (HashSet Span)) => SC.CoSerial m Spans++--------------------------------------------------------------------------------++-- | Represents a span of source code.+--+--   @since 0.1.0+data Span+  = MkSpan !(Maybe Misc.Path) !Offset !Offset+  deriving (Eq, Show, Generic)++-- | Construct a 'Span' from a given start position to a given end position.+--+--   @since 0.1.0+{-# INLINE makeSpan #-}+makeSpan :: Maybe Misc.Path+         -- ^ The file in which this span resides, if any.+         -> Offset+         -- ^ The start offset.+         -> Offset+         -- ^ The end offset.+         -> Span+makeSpan mpath start end = case compareOffset start end of+                             GT -> makeSpan mpath end start+                             _  -> MkSpan mpath start end++-- | A lens into the (nullable) path associated with a 'Span'.+--+--   @since 0.1.0+{-# INLINE spanPath #-}+spanPath :: Lens.Lens' Span (Maybe Misc.Path)+spanPath = let helper (MkSpan p s e) = (p, \x -> MkSpan x s e)+           in Lens.lens (helper .> fst) (helper .> snd)++-- | A lens giving the start and end 'Offset's associated with a 'Span'.+--+--   @since 0.1.0+{-# INLINE spanRange #-}+spanRange :: Lens.Lens' Span (Offset, Offset)+spanRange = let helper (MkSpan p s e) = ((s, e), \(s', e') -> MkSpan p s' e')+            in Lens.lens (helper .> fst) (helper .> snd)++-- | A lens into the 'Offset' associated with the start of a 'Span'.+--+--   @since 0.1.0+{-# INLINE spanStart #-}+spanStart :: Lens.Lens' Span Offset+spanStart = spanRange . Lens._1++-- | A lens into the 'Offset' associated with the end of a 'Span'.+--+--   @since 0.1.0+{-# INLINE spanEnd #-}+spanEnd :: Lens.Lens' Span Offset+spanEnd = spanRange . Lens._2++-- | A getter for the 'Position' associated with the start of a 'Span'.+--+--   @since 0.1.0+{-# INLINE spanStartPos #-}+spanStartPos :: Lens.Getter Span Position+spanStartPos = Lens.to (\(MkSpan p s _) -> makePosition p s)++-- | A getter for the 'Position' associated with the end of a 'Span'.+--+--   @since 0.1.0+{-# INLINE spanEndPos #-}+spanEndPos :: Lens.Getter Span Position+spanEndPos = Lens.to (\(MkSpan p _ e) -> makePosition p e)++-- | Converts to @{file: …, start: …, end: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Span where+  toJSON (MkSpan file start end)+    = [ "file"  .= maybe Aeson.Null Aeson.toJSON file+      , "start" .= offsetJ start+      , "end"   .= offsetJ end+      ] |> Aeson.object+    where+      offsetJ :: (Line, Column) -> Aeson.Value+      offsetJ (line, col) = Aeson.object ["line" .= line, "col" .= col]++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Span where+  parseJSON = (Aeson.withObject "Span" $ \o -> do+                  file  <- (o .: "file")  >>= pure+                  start <- (o .: "start") >>= offsetP+                  end   <- (o .: "end")   >>= offsetP+                  pure (MkSpan file start end))+    where+      offsetP :: Aeson.Value -> Aeson.Parser Offset+      offsetP = (Aeson.withObject "Offset" $ \o -> do+                    line <- (o .: "line") >>= pure+                    col  <- (o .: "col")  >>= pure+                    pure (line, col))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Span++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Span++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m Span++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m Span++--------------------------------------------------------------------------------++-- | This datatype represents the position of a cursor in a text file.+--+--   @since 0.1.0+data Position+  = MkPosition+    { _positionFile ::                !(Maybe Misc.Path)+    , _positionLine :: {-# UNPACK #-} !Line+    , _positionCol  :: {-# UNPACK #-} !Column+    }+  deriving (Eq, Show, Generic)++-- | Construct a 'Position' from a (nullable) path and a @(line, column)@ pair.+--+--   @since 0.1.0+{-# INLINE makePosition #-}+makePosition :: Maybe Misc.Path -> Offset -> Position+makePosition file (line, column) = MkPosition file line column++-- | The path of the file pointed to by this position, if any.+--+--   @since 0.1.0+{-# INLINE positionFile #-}+positionFile :: Lens.Lens' Position (Maybe Misc.Path)+positionFile = Lens.lens _positionFile+               $ \(MkPosition {..}) x -> MkPosition { _positionFile = x, .. }++-- | The offset in the file pointed to by this position.+--+--   @since 0.1.0+{-# INLINE positionOffset #-}+positionOffset :: Lens.Lens' Position Offset+positionOffset+  = Lens.lens (_positionLine &&& _positionCol)+    $ \(MkPosition {..}) (line, col) ->+        MkPosition { _positionLine = line, _positionCol = col, .. }++-- | The line number in the file pointed to by this position.+--+--   @since 0.1.0+{-# INLINE positionLine #-}+positionLine :: Lens.Lens' Position Line+positionLine = positionOffset . Lens._1++-- | The column number in the line pointed to by this position.+--+--   @since 0.1.0+{-# INLINE positionCol #-}+positionCol :: Lens.Lens' Position Column+positionCol = positionOffset . Lens._2++-- | If two 'Position's are comparable (i.e.: if they are in the same file),+--   this function will return an 'Ordering' giving their relative positions.+--   Otherwise, it will of course return 'Nothing'.+--+--   @since 0.1.0+comparePosition :: Position -> Position -> Maybe Ordering+comparePosition = go+  where+    go (MkPosition fileX lineX colX) (MkPosition fileY lineY colY)+      = compareTriple (fileX, (lineX, colX)) (fileY, (lineY, colY))++    compareTriple :: (Maybe Misc.Path, Offset) -> (Maybe Misc.Path, Offset)+                  -> Maybe Ordering+    compareTriple (mfileX, offX) (mfileY, offY)+      | (mfileX == mfileY) = Just (compareOffset offX offY)+      | otherwise          = Nothing++-- | Converts to @{file: …, line: …, col: …}@.+--+--   @since 0.1.0+instance Aeson.ToJSON Position where+  toJSON (MkPosition {..})+    = [ "file" .= _positionFile+      , "line" .= _positionLine+      , "col"  .= _positionCol+      ] |> Aeson.object++-- | Inverse of the 'Aeson.ToJSON' instance.+--+--   @since 0.1.0+instance Aeson.FromJSON Position where+  parseJSON = (Aeson.withObject "Position" $ \o -> do+                  _positionFile <- (o .: "file") >>= pure+                  _positionLine <- (o .: "line") >>= pure+                  _positionCol  <- (o .: "col")  >>= pure+                  pure (MkPosition {..}))++-- | Default 'Hashable' instance via 'Generic'.+--+--   @since 0.1.0+instance Hashable Position++-- | Default 'NFData' instance via 'Generic'.+--+--   @since 0.1.0+instance NFData Position++-- | Default 'SC.Serial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m Position++-- | Default 'SC.CoSerial' instance via 'Generic'.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m Position++--------------------------------------------------------------------------------++-- | A line/column offset into a file.+--+--   @since 0.1.0+type Offset = (Line, Column)++-- | Compare two 'Offset's in lexicographic order (i.e.: the 'Column' is+--   ignored unless they are on the same 'Line').+--+--   @since 0.1.0+compareOffset :: Offset -> Offset -> Ordering+compareOffset (lineX, colX) (lineY, colY)+  | (lineX < lineY) = LT+  | (lineX > lineY) = GT+  | otherwise       = compare colX colY++-- | A lens into the 'Line' associated with an 'Offset'.+--+--   For now, this is simply defined as @offsetLine = 'Lens._1'@,+--   but if 'Offset' is later refactored to be an abstract data type, using+--   this lens instead of 'Lens._1' will decrease the amount of code that+--   breaks.+--+--   @since 0.1.0+{-# INLINE offsetLine #-}+offsetLine :: Lens.Lens' Offset Line+offsetLine = Lens._1++-- | A lens into the 'Line' associated with an 'Offset'.+--+--   Read the description of 'offsetLine' for an understanding of why this+--   exists and why you should use it instead of 'Lens._2'.+--+--   @since 0.1.0+{-# INLINE offsetColumn #-}+offsetColumn :: Lens.Lens' Offset Column+offsetColumn = Lens._2++--------------------------------------------------------------------------------++-- | A line number.+--+--   @since 0.1.0+type Line = Int++-- | A column number.+--+--   @since 0.1.0+type Column = Int++--------------------------------------------------------------------------------++data Chunk+  = ChunkText                 !Text+  | ChunkSpace {-# UNPACK #-} !Int+  | ChunkLine  {-# UNPACK #-} !Int+  deriving (Eq, Show)++--------------------------------------------------------------------------------++newtype Chunks+  = MkChunks { fromChunks :: [Chunk] }+  deriving (Eq, Show)++{-# INLINE chunksNil #-}+chunksNil :: Chunks+chunksNil = MkChunks []++chunksCons :: Chunk -> Chunks -> Chunks+chunksCons = \chunk (MkChunks list) -> MkChunks (go chunk list)+  where+    {-# INLINE go #-}+    go (ChunkSpace m) (ChunkSpace n : rest) = ChunkSpace (m + n)  : rest+    go (ChunkLine  m) (ChunkLine  n : rest) = ChunkLine  (m + n)  : rest+    go (ChunkText  a) (ChunkText  b : rest) = ChunkText  (a <> b) : rest+    go other          list                  = other               : list++{-# INLINE chunksAddChar #-}+chunksAddChar :: Char -> Chunks -> Chunks+chunksAddChar '\n'             = chunksCons (ChunkLine 1)+chunksAddChar '\r'             = id+chunksAddChar c    | isSpace c = chunksCons (ChunkSpace 1)+chunksAddChar c                = chunksCons (ChunkText (Text.singleton c))++--------------------------------------------------------------------------------++removeWhitespace :: (Maybe Misc.Path, Line, Column) -> Text -> [Located Text]+removeWhitespace (file, initLine, initCol) =+  go .> Data.Maybe.catMaybes .> map makeLoc+  where+    go :: Text -> [Maybe (Line, Column, Text)]+    go text = ST.runST $ do+      ref <- ST.newSTRef (initLine, initCol)+      Text.foldr chunksAddChar chunksNil text+        |> fromChunks+        |> mapM (applyChunk ref)++    applyChunk :: STRef s (Line, Column)+               -> Chunk -> ST s (Maybe (Line, Column, Text))+    applyChunk ref = \case+      ChunkLine  n -> do ST.modifySTRef' ref ((+ n) *** const 0)+                         pure Nothing+      ChunkSpace n -> do ST.modifySTRef' ref (second (+ n))+                         pure Nothing+      ChunkText  t -> do (line, column) <- ST.readSTRef ref+                         ST.modifySTRef' ref (second (+ Text.length t))+                         pure (Just (line, column, t))++    {-# INLINE makeLoc #-}+    makeLoc :: (Line, Column, Text) -> Located Text+    makeLoc (line, col, text) = makeLocated (MkPosition file line col) text++--------------------------------------------------------------------------------
+ library/Language/Ninja/Misc/Path.hs view
@@ -0,0 +1,127 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Misc/Path.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.++{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE UndecidableInstances       #-}++-- |+--   Module      : Language.Ninja.Misc.Path+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A datatype for Unix path strings.+--+--   @since 0.1.0+module Language.Ninja.Misc.Path+  ( Path, makePath, pathIText, pathText, pathString, pathFP+  ) where++import           Language.Ninja.Misc.IText (IText)+import qualified Language.Ninja.Misc.IText as Ninja++import           Data.Text                 (Text)+import qualified Data.Text                 as Text++import qualified Filesystem.Path.CurrentOS as FP++import qualified Data.Aeson                as Aeson++import           Control.DeepSeq           (NFData)+import           Data.Hashable             (Hashable)+import           Data.String               (IsString)+import           GHC.Generics              (Generic)+import           Test.SmallCheck.Series    ((>>-))+import qualified Test.SmallCheck.Series    as SC++import qualified Control.Lens              as Lens++import           Flow                      ((.>))++--------------------------------------------------------------------------------++-- | This type represents a Unix path string.+--+--   @since 0.1.0+newtype Path+  = MkPath+    { _pathIText :: IText+    }+  deriving ( Eq, Ord, Show, Read, IsString, Generic, Hashable, NFData+           , Aeson.ToJSON, Aeson.FromJSON, Aeson.ToJSONKey, Aeson.FromJSONKey )++-- | Construct a 'Path' from some 'Text'.+--+--   @since 0.1.0+{-# INLINE makePath #-}+makePath :: Text -> Path+makePath = Lens.view Ninja.itext .> MkPath++-- | An isomorphism between a 'Path' and its underlying 'IText'.+--+--   @since 0.1.0+{-# INLINE pathIText #-}+pathIText :: Lens.Iso' Path IText+pathIText = Lens.iso _pathIText MkPath++-- | An isomorphism that gives access to a 'Text'-typed view of a 'Path',+--   even though the underlying data has type 'IText'.+--+--   This is equivalent to @pathIText . from Ninja.itext@.+--+--   @since 0.1.0+{-# INLINE pathText #-}+pathText :: Lens.Iso' Path Text+pathText = pathIText . Lens.from Ninja.itext++-- | An isomorphism that gives access to a 'String'-typed view of a 'Path'.+--+--   @since 0.1.0+{-# INLINE pathString #-}+pathString :: Lens.Iso' Path String+pathString = pathText . Lens.iso Text.unpack Text.pack++-- | An isomorphism between a 'Path' and a 'FP.FilePath' from @system-filepath@.+--   This uses 'FP.decodeString' and 'FP.encodeString', so all the caveats on+--   those functions apply here.+--+--   @since 0.1.0+{-# INLINE pathFP #-}+pathFP :: Lens.Iso' Path FP.FilePath+pathFP = pathString . Lens.iso FP.decodeString FP.encodeString++-- | Uses the underlying 'IText' instance.+--+--   @since 0.1.0+instance (Monad m, SC.Serial m Text) => SC.Serial m Path where+  series = SC.newtypeCons MkPath++-- | Uses the underlying 'IText' instance.+--+--   @since 0.1.0+instance (Monad m, SC.CoSerial m Text) => SC.CoSerial m Path where+  coseries rs = SC.newtypeAlts rs+                >>- \f -> pure (_pathIText .> f)++--------------------------------------------------------------------------------
+ library/Language/Ninja/Misc/Positive.hs view
@@ -0,0 +1,113 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Misc/Positive.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.++{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE UndecidableInstances       #-}++-- |+--   Module      : Language.Ninja.Misc.Positive+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A data type for integers greater than zero.+--+--   @since 0.1.0+module Language.Ninja.Misc.Positive+  ( Positive, makePositive, fromPositive+  ) where++import           Control.Applicative    (empty)++import qualified Control.Lens.Getter    as Lens++import qualified Data.Aeson             as Aeson++import           Control.DeepSeq        (NFData)+import           Data.Hashable          (Hashable)+import           GHC.Generics           (Generic)++import qualified Test.SmallCheck.Series as SC++import           Flow                   ((.>), (|>))++--------------------------------------------------------------------------------++-- | This type represents a positive number; i.e.: an integer greater than zero.+--+--   @since 0.1.0+newtype Positive+  = MkPositive+    { _fromPositive :: Int+    }+  deriving ( Eq, Ord, Real, Integral, Enum, Show, Read, Generic+           , Hashable, NFData+           , Aeson.ToJSON, Aeson.FromJSON )++-- | This instance uses 'error' to preserve the 'Positive' invariant.+--+--   @since 0.1.0+instance Num Positive where+  (MkPositive a) + (MkPositive b) = MkPositive (a + b)+  (MkPositive a) * (MkPositive b) = MkPositive (a * b)+  abs = id+  signum = const 1+  negate = ["Prelude.negate: Positive cannot be negated"]+           |> mconcat |> error+  fromInteger i | i > 0     = MkPositive (fromIntegral i)+                | otherwise = [ "Prelude.fromInteger: "+                              , "Positive invariant violated"+                              ] |> mconcat |> error++-- | Constructor for a 'Positive'.+--+--   @since 0.1.0+{-# INLINEABLE makePositive #-}+makePositive :: Int -> Maybe Positive+makePositive i | i > 0     = Just (MkPositive i)+               | otherwise = Nothing++-- | A 'Lens.Getter' for the 'Int' underlying a 'Positive'.+--+--   @since 0.1.0+{-# INLINE fromPositive #-}+fromPositive :: Lens.Getter Positive Int+fromPositive = Lens.to _fromPositive++-- | Uses the underlying 'Int' instance.+--+--   @since 0.1.0+instance (Monad m) => SC.Serial m Positive where+  series = MkPositive <$> (SC.series `suchThat` (> 0))+    where+      suchThat :: SC.Series m a -> (a -> Bool) -> SC.Series m a+      suchThat s p = s >>= \x -> if p x then pure x else empty++-- | Uses the underlying 'Int' instance.+--+--   @since 0.1.0+instance (Monad m) => SC.CoSerial m Positive where+  coseries = SC.coseries .> fmap (\f -> _fromPositive .> f)++--------------------------------------------------------------------------------
+ library/Language/Ninja/Mock.hs view
@@ -0,0 +1,45 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Mock.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-missing-import-lists #-}++-- |+--   Module      : Language.Ninja.Mock+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Typeclasses that allow mocking via dependency injection (i.e.: free monads+--   or similar techniques) in @language-ninja@.+--+--   This module re-exports all of the modules under the "Language.Ninja.Mock"+--   namespace for convenience.+--+--   It is recommended that you import it with the following style:+--+--   > import qualified Language.Ninja.Mock as Mock+--+--   @since 0.1.0+module Language.Ninja.Mock+  ( -- * "Language.Ninja.Mock.ReadFile"+    Mock.MonadReadFile (..)+  ) where++import           Language.Ninja.Mock.ReadFile as Mock
+ library/Language/Ninja/Mock/ReadFile.hs view
@@ -0,0 +1,85 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Mock/ReadFile.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.++{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+--   Module      : Language.Ninja.Mock.ReadFile+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A typeclass exposing an interface that allows reading a file from a+--   filesystem (virtual or otherwise).+--+--   @since 0.1.0+module Language.Ninja.Mock.ReadFile+  ( MonadReadFile (..)+  ) where++import           Prelude                   (IO, Monad)++import           Control.Monad.Trans.Class (MonadTrans (lift))++import qualified Control.Lens              as Lens++import           Data.Text                 (Text)+import qualified Data.Text.IO              as Text++import           Language.Ninja.Misc.Path  (Path, pathString)++import           Flow                      ((.>))++--------------------------------------------------------------------------------++-- Remember: we have imported Prelude hiding 'readFile'.++-- | This typeclass allows you to write code that reads files from the+--   filesystem and then later run that code purely against a virtual filesystem+--   of some description.+--+--   @since 0.1.0+class (Monad m) => MonadReadFile m where+  {-# MINIMAL readFile #-}++  -- | Read the file located at the given path and decode it into 'Text'.+  --+  --   TODO: some notion of error handling should be encoded into the type+  --+  --   @since 0.1.0+  readFile :: Path -> m Text++-- | The obvious instance for 'IO'.+--+--   @since 0.1.0+instance MonadReadFile IO where+  readFile = Lens.view pathString .> Text.readFile++-- | A placeholder (undecidable) instance that allows this constraint to+--   propagate through monad transformers without needing to 'lift' manually.+--+--   @since 0.1.0+instance ( MonadTrans t, Monad (t m), MonadReadFile m+         ) => MonadReadFile (t m) where+  readFile = readFile .> lift++--------------------------------------------------------------------------------
+ library/Language/Ninja/Parser.hs view
@@ -0,0 +1,372 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Parser.hs+--+-- License:+--     Copyright Neil Mitchell  2011-2017.+--     Copyright Awake Networks 2017.+--     All rights reserved.+--+--     Redistribution and use in source and binary forms, with or without+--     modification, are permitted provided that the following conditions are+--     met:+--+--         * Redistributions of source code must retain the above copyright+--           notice, this list of conditions and the following disclaimer.+--+--         * Redistributions in binary form must reproduce the above+--           copyright notice, this list of conditions and the following+--           disclaimer in the documentation and/or other materials provided+--           with the distribution.+--+--         * Neither the name of Neil Mitchell nor the names of other+--           contributors may be used to endorse or promote products derived+--           from this software without specific prior written permission.+--+--     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+--     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+--     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+--     A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+--     OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+--     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+--     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+--     DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+--     THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+--     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+--     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}++-- |+--   Module      : Language.Ninja.Parser+--   Copyright   : Copyright 2011-2017 Neil Mitchell+--   License     : BSD3+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Parse a Ninja file.+--+--   @since 0.1.0+module Language.Ninja.Parser+  ( -- * @parse*IO@+    parseFileIO+  , parseTextIO+  , parseBSIO+  , parseLexemesIO++    -- * @parse*@+  , parseFile+  , parseText+  , parseBS+  , parseLexemes++    -- * @parse*WithEnv@+  , parseFileWithEnv+  , parseTextWithEnv+  , parseBSWithEnv+  , parseLexemesWithEnv+  ) where++import           Control.Arrow              (second)+import           Control.Exception          (throwIO)+import           Control.Monad              ((>=>))++import           Control.Monad.Error.Class  (MonadError)+import           Control.Monad.Trans.Except (runExceptT)++import qualified Control.Lens               as Lens++import           Data.Maybe                 (Maybe (Just, Nothing))+import           Data.Monoid                (Endo (Endo, appEndo), (<>))++import qualified Data.ByteString.Char8      as BSC8++import           Data.Text                  (Text)+import qualified Data.Text.Encoding         as Text++import qualified Data.HashMap.Strict        as HM++import           Data.HashSet               (HashSet)+import qualified Data.HashSet               as HS++import           Language.Ninja.Lexer       (Ann)++import qualified Language.Ninja.AST         as AST+import qualified Language.Ninja.Errors      as Errors+import qualified Language.Ninja.Lexer       as Lexer+import qualified Language.Ninja.Misc        as Misc+import qualified Language.Ninja.Mock        as Mock++import           Flow                       ((.>), (|>))++--------------------------------------------------------------------------------++-- | Parse the file at the given path into a 'AST.Ninja'.+--   This function may throw an exception if parsing fails.+--+--   @since 0.1.0+parseFileIO :: Misc.Path -> IO (AST.Ninja Ann)+parseFileIO file = forceIO (parseFile file)++-- | Parse the given 'Text' into a 'AST.Ninja'.+--   This function may throw an exception if parsing fails.+--+--   @since 0.1.0+parseTextIO :: Text -> IO (AST.Ninja Ann)+parseTextIO text = forceIO (parseText text)++-- | Parse the given 'BSC8.ByteString' into a 'AST.Ninja'.+--   This function may throw an exception if parsing fails.+--+--   @since 0.1.0+parseBSIO :: BSC8.ByteString -> IO (AST.Ninja Ann)+parseBSIO bs = forceIO (parseBS bs)++-- | Parse the given list of 'Lexer.Lexeme's into a 'AST.Ninja'.+--   This function may throw an exception if parsing fails.+--+--   @since 0.1.0+parseLexemesIO :: [Lexer.Lexeme Ann] -> IO (AST.Ninja Ann)+parseLexemesIO lexemes = forceIO (parseLexemes lexemes)++--------------------------------------------------------------------------------++-- | Parse the file at the given path into a 'AST.Ninja'.+--+--   @since 0.1.0+parseFile :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+          => Misc.Path -> m (AST.Ninja Ann)+parseFile file = parseFileWithEnv file AST.makeEnv++-- | Parse the given 'Text' into a 'AST.Ninja'.+--+--   @since 0.1.0+parseText :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+          => Text -> m (AST.Ninja Ann)+parseText text = parseTextWithEnv text AST.makeEnv++-- | Parse the given 'BSC8.ByteString' into a 'AST.Ninja'.+--+--   @since 0.1.0+parseBS :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+          => BSC8.ByteString -> m (AST.Ninja Ann)+parseBS bs = parseBSWithEnv bs AST.makeEnv++-- | Parse the given list of 'Lexer.Lexeme's into a 'AST.Ninja'.+--+--   @since 0.1.0+parseLexemes :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+             => [Lexer.Lexeme Ann] -> m (AST.Ninja Ann)+parseLexemes lexemes = parseLexemesWithEnv lexemes AST.makeEnv++--------------------------------------------------------------------------------++-- | Parse the file at the given path using the given Ninja variable context,+--   resulting in a 'AST.Ninja'.+--+--   @since 0.1.0+parseFileWithEnv :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                 => Misc.Path -> AST.Env Text Text -> m (AST.Ninja Ann)+parseFileWithEnv path env = fst <$> parseFileInternal path (AST.makeNinja, env)++-- | Parse the given 'Text' using the given Ninja variable context,+--   resulting in a 'AST.Ninja'.+--+--   @since 0.1.0+parseTextWithEnv :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                 => Text -> AST.Env Text Text -> m (AST.Ninja Ann)+parseTextWithEnv text env = fst <$> parseTextInternal text (AST.makeNinja, env)++-- | Parse the given 'BSC8.ByteString' using the given Ninja variable context,+--   resulting in a 'AST.Ninja'.+--+--   @since 0.1.0+parseBSWithEnv :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                 => BSC8.ByteString -> AST.Env Text Text -> m (AST.Ninja Ann)+parseBSWithEnv bs env = fst <$> parseBSInternal bs (AST.makeNinja, env)++-- | Parse the given list of 'Lexer.Lexeme's into a 'AST.Ninja'.+--+--   @since 0.1.0+parseLexemesWithEnv :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                    => [Lexer.Lexeme Ann] -> AST.Env Text Text+                    -> m (AST.Ninja Ann)+parseLexemesWithEnv lexemes env+  = fst <$> parseLexemesInternal lexemes (AST.makeNinja, env)++--------------------------------------------------------------------------------++type NinjaWithEnv = (AST.Ninja Ann, AST.Env Text Text)++--------------------------------------------------------------------------------++parseFileInternal :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                  => Misc.Path -> NinjaWithEnv -> m NinjaWithEnv+parseFileInternal path (ninja, env) = do+  text <- Mock.readFile path+  parseTextInternal text (ninja, env)++parseTextInternal :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                  => Text -> NinjaWithEnv -> m NinjaWithEnv+parseTextInternal text = parseBSInternal (Text.encodeUtf8 text)++parseBSInternal :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                  => BSC8.ByteString -> NinjaWithEnv -> m NinjaWithEnv+parseBSInternal bs (ninja, env) = do+  lexemes <- Lexer.lexBS bs+  parseLexemesInternal lexemes (ninja, env)++parseLexemesInternal :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+                     => [Lexer.Lexeme Ann] -> NinjaWithEnv -> m NinjaWithEnv+parseLexemesInternal lexemes (ninja, env) = withBinds lexemes+                                            |> map (uncurry applyStmt)+                                            |> foldr (>=>) pure+                                            |> (\f -> f (ninja, env))+                                            |> fmap addSpecialVars++--------------------------------------------------------------------------------++type MonadApplyFun m = (MonadError Errors.ParseError m, Mock.MonadReadFile m)+type ApplyFun' m = [(Text, AST.Expr Ann)] -> NinjaWithEnv -> m NinjaWithEnv+type ApplyFun = (forall m. (MonadApplyFun m) => ApplyFun' m)++--------------------------------------------------------------------------------++forceIO :: (forall m. (MonadApplyFun m) => m a) -> IO a+forceIO action = runExceptT action >>= either throwIO pure++--------------------------------------------------------------------------------++addSpecialVars :: NinjaWithEnv -> NinjaWithEnv+addSpecialVars (ninja, env) = (mutator ninja, env)+  where+    specialVars :: [Text]+    specialVars = ["ninja_required_version", "builddir"]++    addVar :: Text -> (AST.Ninja Ann -> AST.Ninja Ann)+    addVar name = case AST.askEnv env name of+                    (Just v) -> Lens.over AST.ninjaSpecials (HM.insert name v)+                    Nothing  -> id++    mutator :: AST.Ninja Ann -> AST.Ninja Ann+    mutator = map addVar specialVars |> map Endo |> mconcat |> appEndo++withBinds :: [Lexer.Lexeme Ann] -> [(Lexer.Lexeme Ann, [(Text, AST.Expr Ann)])]+withBinds = \case []     -> []+                  (x:xs) -> let (a, b) = f xs+                            in (x, a) : withBinds b+  where+    f :: [Lexer.Lexeme Ann] -> ([(Text, AST.Expr Ann)], [Lexer.Lexeme Ann])+    f (Lexer.LexBind _ binding : rest) = let Lexer.MkLBind _ name b = binding+                                             Lexer.MkLName _ a = name+                                             (as, bs) = f rest+                                         in ((Text.decodeUtf8 a, b) : as, bs)+    f xs                               = ([], xs)++--------------------------------------------------------------------------------++applyStmt :: Lexer.Lexeme Ann -> ApplyFun+applyStmt lexeme binds (ninja, env)+  = (case lexeme of+       (Lexer.LexBuild    _ann   lbuild) -> applyBuild    lbuild+       (Lexer.LexRule     _ann    lname) -> applyRule     lname+       (Lexer.LexDefault  _ann defaults) -> applyDefault  defaults+       (Lexer.LexPool     _ann    lname) -> applyPool     lname+       (Lexer.LexInclude  _ann    lfile) -> applyInclude  lfile+       (Lexer.LexSubninja _ann    lfile) -> applySubninja lfile+       (Lexer.LexDefine   _ann    lbind) -> applyDefine   lbind+       (Lexer.LexBind     _ann    lbind) -> throwUnexpectedBinding lbind)+    |> (\f -> f binds (ninja, env))+  where+    -- TODO: don't discard annotation+    throwUnexpectedBinding :: Lexer.LBind Ann -> ApplyFun+    throwUnexpectedBinding (Lexer.MkLBind _ (Lexer.MkLName _ var) _)+      = \_ _ -> Errors.throwParseUnexpectedBinding (Text.decodeUtf8 var)++applyBuild :: Lexer.LBuild Ann -> ApplyFun+applyBuild (Lexer.MkLBuild _annB loutputs lrule ldeps) lbinds (ninja, env) = do+  let outputs = map (AST.askExpr env) loutputs+  let rule    = lrule |> (\(Lexer.MkLName _annN name) -> Text.decodeUtf8 name)+  let deps    = HS.fromList (map (AST.askExpr env) ldeps)+  let binds   = HM.fromList (map (second (AST.askExpr env)) lbinds)+  let (normal, implicit, orderOnly) = splitDeps deps+  let build = AST.makeBuild rule env+              |> (Lens.set (AST.buildDeps . AST.depsNormal)    normal)+              |> (Lens.set (AST.buildDeps . AST.depsImplicit)  implicit)+              |> (Lens.set (AST.buildDeps . AST.depsOrderOnly) orderOnly)+              |> (Lens.set AST.buildBind                       binds)+  let allDeps = normal <> implicit <> orderOnly+  let addP = \p -> [(x, allDeps) | x <- outputs] <> (HM.toList p)+                   |> HM.fromList+  let addS = HM.insert (head outputs) build+  let addM = HM.insert (HS.fromList outputs) build+  let ninja' | (rule == "phony")     = Lens.over AST.ninjaPhonys    addP ninja+             | (length outputs == 1) = Lens.over AST.ninjaSingles   addS ninja+             | otherwise             = Lens.over AST.ninjaMultiples addM ninja+  pure (ninja', env)++applyRule :: Lexer.LName Ann -> ApplyFun+applyRule (Lexer.MkLName ann name) binds (ninja, env) = do+  let rule = AST.makeRule+             |> Lens.set Misc.annotation ann+             |> Lens.set AST.ruleBind    (HM.fromList binds)+  let nameT = Text.decodeUtf8 name+  pure (ninja |> Lens.over AST.ninjaRules (HM.insert nameT rule), env)++applyDefault :: [AST.Expr Ann] -> ApplyFun+applyDefault ldefaults _ (ninja, env) = do+  let defaults = HS.fromList (map (AST.askExpr env) ldefaults)+  pure (ninja |> Lens.over AST.ninjaDefaults (defaults <>), env)++applyPool :: Lexer.LName Ann -> ApplyFun+applyPool (Lexer.MkLName _ann name) binds (ninja, env) = do+  depth <- getDepth env binds+  let nameT = Text.decodeUtf8 name+  pure (ninja |> Lens.over AST.ninjaPools (HM.insert nameT depth), env)++applyInclude :: Lexer.LFile Ann -> ApplyFun+applyInclude (Lexer.MkLFile expr) _ (ninja, env) = do+  let file = AST.askExpr env expr |> Lens.view (Lens.from Misc.pathText)+  parseFileInternal file (ninja, env)++applySubninja :: Lexer.LFile Ann -> ApplyFun+applySubninja (Lexer.MkLFile expr) _ (ninja, env) = do+  let file = AST.askExpr env expr |> Lens.view (Lens.from Misc.pathText)+  parseFileInternal file (ninja, AST.scopeEnv env)++applyDefine :: Lexer.LBind Ann -> ApplyFun+applyDefine (Lexer.MkLBind _annB (Lexer.MkLName _annN var) value) _ (ninja, env)+  = pure (ninja, AST.addBind (Text.decodeUtf8 var) value env)++--------------------------------------------------------------------------------++splitDeps :: HashSet Text -> (HashSet Text, HashSet Text, HashSet Text)+splitDeps = HS.toList+            .> go+            .> (\(a, b, c) -> (HS.fromList a, HS.fromList b, HS.fromList c))+  where+    go :: [Text] -> ([Text], [Text], [Text])+    go []                   = ([],      [],     [])+    go (x:xs) | (x == "|")  = ([],  a <> b,      c)+              | (x == "||") = ([],       b, a <> c)+              | otherwise   = (x:a,      b,      c)+      where+        (a, b, c) = go xs++getDepth :: (MonadError Errors.ParseError m)+         => AST.Env Text Text -> [(Text, AST.Expr Ann)] -> m Int+getDepth env xs+  = case AST.askExpr env <$> lookup "depth" xs of+      Nothing  -> pure 1+      (Just x) -> case BSC8.readInt (Text.encodeUtf8 x) of+                    (Just (i, n)) | n == "" -> pure i+                    _                       -> Errors.throwParseBadDepthField x++--------------------------------------------------------------------------------
+ library/Language/Ninja/Pretty.hs view
@@ -0,0 +1,218 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Pretty.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.++{-# LANGUAGE OverloadedStrings #-}++-- |+--   Module      : Language.Ninja.Pretty+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Rudimentary pretty-printers for various types in @language-ninja@.+--+--   @since 0.1.0+module Language.Ninja.Pretty+  ( -- * Pretty-printer for 'Lexer.Lexeme'+    prettyLexemes+  , prettyLexeme+    -- * Pretty-printer for @AST.'AST.Ninja'@+  , prettyNinja+  , prettyExpr+  , prettyRule+  , prettySingle+  , prettyMultiple+  , prettyPhony+  , prettyDefault+  , prettyPool+  , prettyBind+  ) where++import           Control.Arrow        (second)++import qualified Control.Lens         as Lens++import qualified Language.Ninja.AST   as AST+import qualified Language.Ninja.Lexer as Lexer++import qualified Data.HashMap.Strict  as HM++import           Data.HashSet         (HashSet)+import qualified Data.HashSet         as HS++import           Data.Text            (Text)+import qualified Data.Text            as Text+import qualified Data.Text.Encoding   as Text++import           Data.Char            (isSpace)+import           Data.Monoid          ((<>))++import           Flow                 ((.>), (|>))++--------------------------------------------------------------------------------++-- | Pretty-print a list of Ninja lexemes.+--+--   @since 0.1.0+prettyLexemes :: [Lexer.Lexeme ()] -> Text+prettyLexemes = map prettyLexeme .> mconcat++-- | Pretty-print a Ninja lexeme.+--+--   @since 0.1.0+prettyLexeme :: Lexer.Lexeme () -> Text+prettyLexeme = go+  where+    go :: Lexer.Lexeme () -> Text+    go (Lexer.LexDefine   _  bind) = ppBind bind <> "\n"+    go (Lexer.LexBind     _  bind) = "  " <> ppBind bind <> "\n"+    go (Lexer.LexInclude  _  file) = "include " <> ppFile file <> "\n"+    go (Lexer.LexSubninja _  file) = "subninja " <> ppFile file <> "\n"+    go (Lexer.LexBuild    _ build) = "build " <> ppBuild build <> "\n"+    go (Lexer.LexRule     _  name) = "rule " <> ppName name <> "\n"+    go (Lexer.LexPool     _  name) = "pool " <> ppName name <> "\n"+    go (Lexer.LexDefault  _ exprs) = mconcat (map ppDefault exprs)+++    ppBind :: Lexer.LBind () -> Text+    ppBind (Lexer.MkLBind _ name value)+      = ppName name <> " = " <> prettyExpr value++    ppFile :: Lexer.LFile () -> Text+    ppFile (Lexer.MkLFile expr) = prettyExpr expr++    ppName :: Lexer.LName () -> Text+    ppName (Lexer.MkLName _ bs) = Text.decodeUtf8 bs++    ppBuild :: Lexer.LBuild () -> Text+    ppBuild (Lexer.MkLBuild _ outs rule deps)+      = [ Text.intercalate " " (map prettyExpr outs)+        , " : ", ppName rule, " "+        , Text.intercalate " " (map prettyExpr deps)+        ] |> mconcat++    ppDefault :: AST.Expr () -> Text+    ppDefault expr = "default " <> prettyExpr expr <> "\n"++--------------------------------------------------------------------------------++-- | Pretty-print a 'AST.Ninja'.+--+--   @since 0.1.0+prettyNinja :: AST.Ninja () -> Text+prettyNinja ninja+  = [ map prettyRule     (HM.toList (Lens.view AST.ninjaRules     ninja))+    , map prettySingle   (HM.toList (Lens.view AST.ninjaSingles   ninja))+    , map prettyMultiple (HM.toList (Lens.view AST.ninjaMultiples ninja))+    , map prettyPhony    (HM.toList (Lens.view AST.ninjaPhonys    ninja))+    , map prettyDefault  (HS.toList (Lens.view AST.ninjaDefaults  ninja))+    , map prettyPool     (HM.toList (Lens.view AST.ninjaPools     ninja))+    ] |> mconcat |> mconcat++-- | Pretty-print an 'AST.Expr'+--+--   @since 0.1.0+prettyExpr :: AST.Expr () -> Text+prettyExpr = go .> mconcat+  where+    go (AST.Exprs _   es) = map prettyExpr es+    go (AST.Lit   _ text) = [text]+    go (AST.Var   _ name) = ["${", name, "}"]++-- | Pretty-print a Ninja @rule@ declaration.+--+--   @since 0.1.0+prettyRule :: (Text, AST.Rule ()) -> Text+prettyRule (name, rule) = do+  let binds = Lens.view AST.ruleBind rule+              |> HM.toList+              |> map (second prettyExpr .> prettyBind)+              |> mconcat+  mconcat ["rule ", name, "\n", binds]++-- | Pretty-print a Ninja @build@ declaration with one output.+--+--   @since 0.1.0+prettySingle :: (Text, AST.Build ()) -> Text+prettySingle (output, build) = prettyMultiple (HS.singleton output, build)++-- | Pretty-print a Ninja @build@ declaration with multiple outputs.+--+--   @since 0.1.0+prettyMultiple :: (HashSet Text, AST.Build ()) -> Text+prettyMultiple (outputs, build) = do+  let prefixIfThere :: Text -> Text -> Text+      prefixIfThere pfx rest = if Text.all isSpace rest then "" else pfx <> rest++  let unwordsSet :: HashSet Text -> Text+      unwordsSet = HS.toList .> Text.unwords++  let ruleName  = Lens.view AST.buildRule build+  let deps      = Lens.view AST.buildDeps build+  let binds     = Lens.view AST.buildBind build+  let normal    = Lens.view AST.depsNormal    deps+  let implicit  = Lens.view AST.depsImplicit  deps+  let orderOnly = Lens.view AST.depsOrderOnly deps++  mconcat+    [ "build ", Text.unwords (HS.toList outputs), ": "+    , ruleName, " ", unwordsSet normal+    , prefixIfThere " | "  (unwordsSet implicit)+    , prefixIfThere " || " (unwordsSet orderOnly), "\n"+    , HM.toList binds |> map prettyBind |> mconcat+    ]++-- | Pretty-print a Ninja phony @build@ declaration.+--+--   @since 0.1.0+prettyPhony :: (Text, HashSet Text) -> Text+prettyPhony (name, inputs)+  = [ ["build ", name, ": phony ", Text.unwords (HS.toList inputs)]+    ] |> map mconcat |> Text.unlines++-- | Pretty-print a Ninja @default@ declaration.+--+--   @since 0.1.0+prettyDefault :: Text -> Text+prettyDefault target+  = [ ["default ", target]+    ] |> map mconcat |> Text.unlines++-- | Pretty-print a Ninja @pool@ declaration.+--+--   @since 0.1.0+prettyPool :: (Text, Int) -> Text+prettyPool (name, depth)+  = [ ["pool ", name]+    , ["    depth = ", tshow depth]+    ] |> map mconcat |> Text.unlines++-- | Pretty-print a Ninja indented binding.+--+--   @since 0.1.0+prettyBind :: (Text, Text) -> Text+prettyBind (name, value) = mconcat ["    ", name, " = ", value, "\n"]++--------------------------------------------------------------------------------++tshow :: (Show s) => s -> Text+tshow = show .> Text.pack++--------------------------------------------------------------------------------
+ library/Language/Ninja/Tutorial.hs view
@@ -0,0 +1,459 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: library/Language/Ninja/Tutorial.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 -Wno-unused-imports #-}++-- |+--   Module      : Language.Ninja.Tutorial+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+module Language.Ninja.Tutorial+  ( -- * Introduction+    -- $introduction++    -- * Lexing+    -- $lexing++    -- * Parsing+    -- $parsing++    -- * Abstract Syntax Tree+    -- $ast++    -- * Compiling+    -- $compiling++    -- * Intermediate Representation+    -- $ir++    -- * Printing+    -- $printing++    -- * Executables+    -- $executables++    -- * Conclusion+    -- $conclusion+  ) where++import qualified Language.Ninja.AST        as AST+import qualified Language.Ninja.Compile    as Compile+import qualified Language.Ninja.Errors     as Errors+import qualified Language.Ninja.IR         as IR+import qualified Language.Ninja.Lexer      as Lexer+import qualified Language.Ninja.Misc       as Misc+import qualified Language.Ninja.Mock       as Mock+import qualified Language.Ninja.Parser     as Parser+import qualified Language.Ninja.Pretty     as Pretty++import           Data.Either               (either)++import           Control.Lens              (Iso', Lens', Prism')+import qualified Control.Lens              as Lens++import           Control.Monad.Error.Class (MonadError)++import           Data.Text                 (Text)+import qualified Data.Text                 as Text++import           Data.HashSet              (HashSet)+import qualified Data.HashSet              as HS++import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as HM++import           Data.Versions             (Version)++--------------------------------------------------------------------------------++-- $introduction+--+-- This library contains most of the utilities you would ever want for working+-- with the <https://ninja-build.org Ninja> build language.+--+-- In general, when using @language-ninja@, you'll want the following imports:+--+-- @+-- import qualified "Language.Ninja.AST"        as AST+-- import qualified "Language.Ninja.IR"         as IR+-- import qualified "Language.Ninja.Errors"     as Errors+-- import qualified "Language.Ninja.Misc"       as Misc+-- import qualified "Language.Ninja.Mock"       as Mock+-- import qualified "Language.Ninja.Lexer"      as Lexer+-- import qualified "Language.Ninja.Parser"     as Parser+-- import qualified "Language.Ninja.Pretty"     as Pretty+-- import qualified "Language.Ninja.Compile"    as Compile+-- @+--+-- For this tutorial, we will also use some other imports:+--+-- @+-- import           "Control.Lens"              ('Iso'', 'Lens'', 'Prism'')+-- import qualified "Control.Lens"              as Lens+--+-- import           "Control.Monad.Error.Class" ('MonadError')+--+-- import           "Data.Either"               ('either')+--+-- import           "Data.Text"                 ('Text')+-- import qualified "Data.Text"                 as Text+--+-- import           "Data.HashSet"              ('HashSet')+-- import qualified "Data.HashSet"              as HS+--+-- import           "Data.HashMap.Strict"       ('HashMap')+-- import qualified "Data.HashMap.Strict"       as HM+--+-- import           "Data.Versions"             ('Version')+-- @++--------------------------------------------------------------------------------++-- $lexing+--+-- To lex a Ninja file, we use the "Language.Ninja.Lexer" module.+-- This results in a list of _annotated_ lexemes:+--+-- @lexFileIO "./build.ninja" :: IO (Lexer.'Lexer.Lexeme' Lexer.'Lexer.Ann')@+--+-- For more specialized use cases, consult the module documentation.++--------------------------------------------------------------------------------++-- $parsing+--+-- To parse a Ninja file, we use the "Language.Ninja.Parse" module.+-- In the simplest case, this amounts to parsing a file:+--+-- @ast <- (Parser.'Parser.parseFileIO' "./build.ninja") :: IO AST.'AST.Ninja'@+--+-- For more specialized use cases, consult the module documentation.++--------------------------------------------------------------------------------++-- $ast+--+-- Now that we have parsed the Ninja file, we can take a look at the AST:+--+-- @+-- let look lens = Lens.'Lens.view' lens ast+-- look AST.'AST.ninjaRules'     :: 'HashMap' 'Text' AST.'AST.Rule'+-- look AST.'AST.ninjaSingles'   :: 'HashMap' 'Text' AST.'AST.Build'+-- look AST.'AST.ninjaMultiples' :: 'HashMap' ('HashSet' 'Text') AST.'AST.Build'+-- look AST.'AST.ninjaPhonys'    :: 'HashMap' 'Text' ('HashSet' 'Text')+-- look AST.'AST.ninjaDefaults'  :: 'HashSet' 'Text'+-- look AST.'AST.ninjaPools'     :: 'HashMap' 'Text' 'Int'+-- look AST.'AST.ninjaSpecials'  :: 'HashMap' 'Text' 'Text'+-- @+--+-- [@AST.'AST.ninjaRules'@]+--   This field corresponds to the @rule@ declarations in the parsed Ninja file.+--   Specifically, it is a map from rule names (as 'Text') to @AST.'AST.Rule'@s.+--+-- [@AST.'AST.ninjaSingles'@]+--   This field contains the set of all non-phony @build@ declarations with+--   exactly one output. Specifically, it is a map from the build output name+--   to an @AST.'AST.Build'@.+--+-- [@AST.'AST.ninjaMultiples'@]+--   This field contains the set of all non-phony @build@ declarations with+--   two or more outputs. Specifically, it is a map from the set of outputs to+--   the corresponding @AST.'AST.Build'@.+--+-- [@AST.'AST.ninjaPhonys'@]+--   This field contains the set of all phony @build@ declarations, as a map+--   from the output name to the set of dependencies. If a phony @build@ has+--   multiple outputs, it will naturally be expanded to multiple entries in+--   this hash map.+--+-- [@AST.'AST.ninjaDefaults'@]+--   This field contains the set of all targets referenced in @default@+--   declarations.+--+-- [@AST.'AST.ninjaPools'@]+--   This field contains the set of all pools defined in the Ninja file,+--   represented as a mapping from the pool name to the pool depth.+--+-- [@AST.'AST.ninjaSpecials'@]+--   This field contains the set of all "special" top-level variables defined+--   in the Ninja file, as a mapping from the variable name to the variable+--   value. As it stands, this map will only ever have at most two keys:+--   @ninja_required_version@ and @builddir@. For more on these variables, look+--   at the manual <https://ninja-build.org/manual.html#ref_toplevel here>.+--+-- == @AST.'AST.Rule'@+--+-- A value of type @AST.'AST.Rule'@ is essentially the set of variables that+-- are bound in a @rule@ body, represented as a map from the variable ('Text')+-- to its unevaluated definition (@AST.'AST.Expr'@). The underlying 'HashMap'+-- can be extracted with @AST.'AST.ruleBind'@.+--+-- == @AST.'AST.Build'@+--+-- A value of type @AST.'AST.Build'@ contains four pieces of information:+--+-- [@AST.'AST.buildRule' :: 'Lens'' AST.'AST.Build' 'Text'@]+--   The name of the @rule@ associated with this @build@ declaration.+-- [@AST.'AST.buildDeps' :: 'Lens'' AST.'AST.Build' AST.'AST.Deps'@]+--   The set of dependencies for this @build@ declaration.+-- [@AST.'AST.buildEnv' :: 'Lens'' AST.'AST.Build' (AST.'AST.Env' 'Text' 'Text')@]+--   The set of file-level variables in scope when the @build@ declaration+--   was parsed.+-- [@AST.'AST.buildBind' :: 'Lens'' AST.'AST.Build' ('HashMap' 'Text' 'Text')@]+--   The set of bindings (indented @key = value@ pairs) for this @build@+--   declaration.+--+-- == @AST.'AST.Deps'@+--+-- A value of type @AST.'AST.Deps'@ contains three pieces of information:+--+-- [@AST.'AST.depsNormal' :: 'Lens'' AST.'AST.Deps' ('HashSet' 'Text')@]+--   The set of "normal" (explicit) dependencies for a @build@ declaration.+-- [@AST.'AST.depsImplicit' :: 'Lens'' AST.'AST.Deps' ('HashSet' 'Text')@]+--   The set of "implicit" dependencies for a @build@ declaration.+-- [@AST.'AST.depsOrderOnly' :: 'Lens'' AST.'AST.Deps' ('HashSet' 'Text')@]+--   The set of "order-only" dependencies for a @build@ declaration.+--+-- <https://ninja-build.org/manual.html#ref_dependencies This> section of the+-- Ninja manual describes in detail the differences between explicit, implicit,+-- and order-only dependencies.++--------------------------------------------------------------------------------++-- $compiling+--+-- To compile a Ninja AST (@AST.'AST.Ninja'@) to the Ninja intermediate+-- representation, we use @compile@ from the "Language.Ninja.Compile" module.+-- In the simplest case, this looks like:+--+-- @+-- let handleError :: Either Errors.'Errors.CompileError' a -> IO a+--     handleError = 'either' ('fail' . 'show') 'pure'+-- ir <- handleError (Compile.'Compile.compile' ast)+-- @+--+-- Since @Compile.'Compile.compile'@ returns in any monad with an instance+-- of @'MonadError' Errors.'Errors.CompileError'@, it is quite flexible.+--+-- For simplicity in this case, however, we use+-- @Either Errors.'Errors.CompileError' AST.'AST.Ninja'@+-- and convert to @IO@ by calling 'fail' when it fails.++--------------------------------------------------------------------------------++-- $ir+--+-- The @language-ninja@ intermediate representation, as defined in the+-- "Language.Ninja.IR" module, is a reduced form of the Ninja AST that handles+-- as much of the static semantics of Ninja as possible.+--+-- The Ninja IR does not have any notion of variables/scoping, does not contain+-- unrestricted hash maps or environments, and has the @rule@ declarations+-- inlined into the @build@ nodes, thus eliminating the "polymorphism"+-- associated with the @$in@ and @$out@ Ninja variables.+--+-- Since we have now compiled the Ninja AST, we can take a look at the IR:+--+-- @+-- let look lens = Lens.'Lens.view' lens ir+-- look IR.'IR.ninjaMeta'     :: IR.'IR.Meta'+-- look IR.'IR.ninjaBuilds'   :: 'HashSet' IR.'IR.Build'+-- look IR.'IR.ninjaPhonys'   :: 'HashMap' IR.'IR.Target' ('HashSet' IR.'IR.Target')+-- look IR.'IR.ninjaDefaults' :: 'HashSet' IR.'IR.Target'+-- look IR.'IR.ninjaPools'    :: 'HashSet' IR.'IR.Pool'+-- @+--+-- These fields correspond to more well-typed versions of their counterparts+-- in the AST. The main differences to note are:+--+-- 1. @AST.'AST.ninjaSpecials'@ is used to compute @IR.'IR.ninjaMeta'@.+-- 2. 'Text' has mostly been replaced with @IR.'IR.Target'@ where relevant.+-- 3. @AST.'AST.ninjaSingles'@ and @AST.'AST.ninjaMultiples'@ have been merged+--    into a single field: @IR.'IR.ninjaBuilds'@.+-- 4. @AST.'AST.ninjaRules'@ is gone; the @rule@s are now inlined into the+--    @build@s that use them.+--+-- == @IR.'IR.Meta'@+--+-- A value of type @IR.'IR.Meta'@ contains two pieces of information:+--+-- [@IR.'IR.metaReqVersion' :: 'Lens'' IR.'IR.Meta' (Maybe 'Version')@]+--   The parsed Ninja version required to build this file.+--   This corresponds to the @ninja_required_version@ top-level variable.+-- [@IR.'IR.metaBuildDir' :: 'Lens'' IR.'IR.Meta' (Maybe Misc.'Misc.Path')@]+--   This corresponds to the @builddir@ top-level variable.+--+-- == @IR.'IR.Build'@+--+-- A value of type @IR.'IR.Build'@ contains three pieces of information:+--+-- [@IR.'IR.buildRule' :: 'Lens'' IR.'IR.Build' IR.'IR.Rule'@]+--   The @rule@ associated with this @build@ declaration.+-- [@IR.'IR.buildOuts' :: 'Lens'' IR.'IR.Build' ('HashSet' IR.'IR.Output')@]+--   The set of outputs for this @build@ declaration.+-- [@IR.'IR.buildDeps' :: 'Lens'' IR.'IR.Build' ('HashSet' IR.'IR.Dependency')@]+--   The set of dependencies for this @build@ declaration.+--+-- == @IR.'IR.Rule'@+--+-- A value of type @IR.'IR.Rule'@ contains a lot of information. For brevity,+-- we will simply list the lens names and types; refer to the module+-- documentation ("Language.Ninja.IR.Rule") for more information.+--+-- @+-- IR.'IR.ruleName'         :: 'Lens'' IR.'IR.Rule' 'Text'+-- IR.'IR.ruleCommand'      :: 'Lens'' IR.'IR.Rule' Misc.'Misc.Command'+-- IR.'IR.ruleDescription'  :: 'Lens'' IR.'IR.Rule' (Maybe 'Text')+-- IR.'IR.rulePool'         :: 'Lens'' IR.'IR.Rule' IR.'IR.PoolName'+-- IR.'IR.ruleDepfile'      :: 'Lens'' IR.'IR.Rule' (Maybe Misc.'Misc.Path')+-- IR.'IR.ruleSpecialDeps'  :: 'Lens'' IR.'IR.Rule' (Maybe IR.'IR.SpecialDeps')+-- IR.'IR.ruleGenerator'    :: 'Lens'' IR.'IR.Rule' Bool+-- IR.'IR.ruleRestat'       :: 'Lens'' IR.'IR.Rule' Bool+-- IR.'IR.ruleResponseFile' :: 'Lens'' IR.'IR.Rule' (Maybe IR.'IR.ResponseFile')+-- @+--+-- == @IR.'IR.Pool'@+--+-- A value of type @IR.'IR.Pool'@ has a name (@IR.'IR.poolName'@) and a+-- depth (@IR.'IR.poolDepth'@). This type is correct-by-construction; it should+-- not be possible to construct a @'IR.Pool'@ that does not correspond to a+-- valid pool definition or reference.++--------------------------------------------------------------------------------++-- $printing+--+-- Currently there is a rudimentary pretty-printer for the lexemes and the AST+-- in the "Language.Ninja.Pretty" module. It simply returns 'Text' such that if+--+-- @+-- let pretty = 'pure' . Pretty.'Pretty.prettyNinja'+-- let parse  = Parser.'Parser.parseTextIO'+-- @+--+-- then @pretty >=> parse >=> pretty >=> parse@ should be the same as @pure@,+-- modulo read-only side effects and annotations.+--+-- There are plans to write a pretty-printer for the IR. This would be very+-- useful for generating Ninja.++--------------------------------------------------------------------------------++-- $executables+--+-- In addition to the library described above, this package also ships with+-- three executables: @ninja-lex@, @ninja-parse@, and @ninja-compile@.+-- These expose the corresponding module by using the Aeson instances to render+-- the lexed\/parsed\/compiled source.+--+-- == @ninja-lex@+--+-- The command-line interface for @ninja-lex@ looks like this:+--+-- > $ ninja-lex --help+-- > ninja-lex version 0.1.0+-- >+-- > Usage: ninja-lex (process | pretty)+-- >+-- > Available options:+-- >   -h,--help                Show this help text+-- >+-- > Available commands:+-- >   process+-- >   pretty+--+-- > $ ninja-lex process --help+-- > Usage: ninja-lex process [--input FILEPATH] [--output FILEPATH]+-- >                          [--machine-readable]+-- >+-- > Available options:+-- >   -h,--help                Show this help text+-- >   --input FILEPATH         Read the given FILEPATH as a Ninja file.+-- >   --output FILEPATH        Output to the given FILEPATH instead of /dev/stdout.+-- >   --machine-readable       Should the output be fully machine-readable?+--+-- > $ ninja-lex pretty --help+-- > Usage: ninja-lex pretty [--input FILEPATH] [--output FILEPATH] [--color]+-- >+-- > Available options:+-- >   -h,--help                Show this help text+-- >   --input FILEPATH         Read the given FILEPATH as a Ninja file.+-- >   --output FILEPATH        Output to the given FILEPATH instead of /dev/stdout.+-- >   --color                  Should the output use ANSI color?+--+-- == @ninja-parse@+--+-- The command-line interface for @ninja-parse@ looks like this:+--+-- > $ ninja-parse --help+-- > ninja-parse version 0.1.0+-- >+-- > Usage: ninja-parse (process | pretty)+-- >+-- > Available options:+-- >   -h,--help                Show this help text+-- >+-- > Available commands:+-- >   process+-- >   pretty+--+-- > $ ninja-parse process --help+-- > Usage: ninja-parse process [--input FILEPATH] [--output FILEPATH]+-- >                            [--machine-readable]+-- >+-- > Available options:+-- >   -h,--help                Show this help text+-- >   --input FILEPATH         Read the given FILEPATH as a Ninja file.+-- >   --output FILEPATH        Output to the given FILEPATH instead of /dev/stdout.+-- >   --machine-readable       Should the output be fully machine-readable?+--+-- > $ ninja-parse pretty --help+-- > Usage: ninja-parse pretty [--input FILEPATH] [--output FILEPATH] [--color]+-- >+-- > Available options:+-- >   -h,--help                Show this help text+-- >   --input FILEPATH         Read the given FILEPATH as a Ninja file.+-- >   --output FILEPATH        Output to the given FILEPATH instead of /dev/stdout.+-- >   --color                  Should the output use ANSI color?+--+-- == @ninja-compile@+--+-- The command-line interface for @ninja-compile@ looks like this:+--+-- > $ ninja-compile --help+-- > ninja-compile version 0.1.0+-- >+-- > Usage: ninja-compile [--input FILEPATH] [--output FILEPATH] [--machine-readable]+-- >+-- > Available options:+-- >   -h,--help                Show this help text+-- >   --input FILEPATH         Read the given FILEPATH as a Ninja file.+-- >   --output FILEPATH        Output to the given FILEPATH instead of /dev/stdout.+-- >   --machine-readable       Should the output be fully machine-readable?++--------------------------------------------------------------------------------++-- $conclusion+--+-- I hope these tools will be useful to you for whatever task you want to do+-- with the Ninja language. Happy hacking!++--------------------------------------------------------------------------------
+ tests/DocTests.hs view
@@ -0,0 +1,40 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: tests/Tests.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.++-- |+--   Module      : Main+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   The @language-ninja@ documentation tests.+module Main (main) where++import qualified Build_doctests as DC+import           Data.Foldable  (traverse_)+import           Test.DocTest   (doctest)++--------------------------------------------------------------------------------++main :: IO ()+main = let args = DC.flags ++ DC.pkgs ++ DC.module_sources+       in traverse_ putStrLn args >> doctest args++--------------------------------------------------------------------------------
+ tests/Tests.hs view
@@ -0,0 +1,554 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: tests/Tests.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.++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Main+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   The @language-ninja@ test suite.+module Main (main) where++import           Data.Maybe                 (catMaybes)+import           Data.Monoid                ((<>))++import qualified Data.Typeable              as Ty++import           Data.Text                  (Text)++import           Control.Exception          (displayException)+import           Control.Monad              (forM, unless, void)+import           Control.Monad.Identity     (Identity)+import           Control.Monad.Trans.Except (ExceptT, runExceptT)++import qualified Control.Lens               as Lens++import qualified Language.Ninja.AST.Env     as AST (Maps)++import qualified Language.Ninja.AST         as AST+import qualified Language.Ninja.Compile     as Compile+import qualified Language.Ninja.Errors      as Errors+import qualified Language.Ninja.IR          as IR+import qualified Language.Ninja.Lexer       as Lexer+import qualified Language.Ninja.Misc        as Misc+import qualified Language.Ninja.Parser      as Parser+import qualified Language.Ninja.Pretty      as Pretty++import           Test.Tasty                 (TestName, TestTree)++import qualified Test.Tasty                 as Test+import qualified Test.Tasty.HUnit           as Test+import qualified Test.Tasty.Ingredients     as Test+import qualified Test.Tasty.Options         as Test+import qualified Test.Tasty.Runners.Html    as Test++import qualified Test.Tasty.QuickCheck      as Test.QC+import qualified Test.Tasty.SmallCheck      as Test.SC++import qualified Test.Tasty.Lens.Iso        as Test.Iso+import qualified Test.Tasty.Lens.Lens       as Test.Lens+import qualified Test.Tasty.Lens.Prism      as Test.Prism++import           Test.QuickCheck            ((===))+import qualified Test.QuickCheck            as QC+import           Test.QuickCheck.Instances  ()++import qualified Test.SmallCheck.Series     as SC++import           Filesystem.Path.CurrentOS  ((</>))+import qualified Filesystem.Path.CurrentOS  as FP++import qualified Data.Aeson                 as Aeson+import qualified Data.Aeson.Types           as Aeson++import qualified Turtle++import           Flow                       ((.>), (|>))++import qualified Tests.Lint                 as Lint+import           Tests.Orphans              ()+import qualified Tests.ReferenceLexer       as RefLex++--------------------------------------------------------------------------------++dataPrefix :: String+dataPrefix = "./tests/data/"++testFiles :: [String]+testFiles = [ "buildseparate"+            , "compdb"+            , "lexical"+            , "lint"+            , "nocreate"+            , "outputtouch"+            , "phonyorder"+            , "redefine"+            , "test1"+            , "test2"+            , "test3"+            , "test4"+            , "test5"+            , "test6"+            ]++aesonSC' :: (Eq x, Show x)+         => SC.Series IO x+         -> (x -> Aeson.Value)+         -> (Aeson.Value -> Aeson.Parser x)+         -> TestTree+aesonSC' s toJ fromJ+  = Test.SC.testProperty "parseJSON . toJSON ≡ₛ pure"+    (Test.SC.over s (\x -> Aeson.parseEither fromJ (toJ x) == Right x))++aesonSC :: forall x.+           ( Eq x, Show x, SC.Serial IO x, Aeson.ToJSON x, Aeson.FromJSON x+           ) => Ty.Proxy x -> TestTree+aesonSC _ = aesonSC' @x SC.series Aeson.toJSON Aeson.parseJSON++aesonQC' :: (Eq x, Show x)+         => (QC.Gen x, x -> [x])+         -> (x -> Aeson.Value)+         -> (Aeson.Value -> Aeson.Parser x)+         -> TestTree+aesonQC' (gen, shrink) toJ fromJ+  = Test.QC.testProperty "parseJSON . toJSON ≡ₐ pure"+    (Test.QC.forAllShrink gen shrink+     (\x -> Aeson.parseEither fromJ (toJ x) === Right x))++aesonQC :: forall x.+           ( Eq x, Show x, QC.Arbitrary x, Aeson.ToJSON x, Aeson.FromJSON x+           ) => Ty.Proxy x -> TestTree+aesonQC _ = aesonQC' @x (QC.arbitrary, QC.shrink) Aeson.toJSON Aeson.parseJSON++parseTestNinja :: String -> IO (AST.Ninja ())+parseTestNinja name = do+  old <- Turtle.pwd+  Turtle.cd (FP.decodeString dataPrefix)+  let file = Lens.view (Lens.from Misc.pathString) (name <> ".ninja")+  result <- Parser.parseFileIO file >>= void .> pure+  Turtle.cd old+  pure result++lexerEquivalentTest :: String -> IO ()+lexerEquivalentTest name = do+  let file = dataPrefix <> name <> ".ninja"+             |> Lens.view (Lens.from Misc.pathString)++  let oldLexer :: Misc.Path -> ExceptT Errors.ParseError IO [Lexer.Lexeme ()]+      oldLexer = RefLex.lexFile++  let newLexer :: Misc.Path -> ExceptT Errors.ParseError IO [Lexer.Lexeme ()]+      newLexer = Lexer.lexFile .> fmap (map void)++  expected <- runExceptT (oldLexer file)+  actual   <- runExceptT (newLexer file)++  unless (expected == actual) $ do+    Test.assertEqual "prefix" expected actual++roundtripTest :: AST.Ninja () -> IO ()+roundtripTest ninja = do+  let withTempDir :: (FP.FilePath -> IO a) -> IO a+      withTempDir = Turtle.with (Turtle.mktempdir "." "test")++  (expected, actual) <- withTempDir $ \tmpdir -> do+    let prettyInput = Pretty.prettyNinja ninja+    let tmpfile = tmpdir </> "generated.ninja"+    Turtle.writeTextFile tmpfile prettyInput+    output <- Parser.parseFileIO (Lens.view (Lens.from Misc.pathFP) tmpfile)+              >>= void .> pure+    let prettyOutput = Pretty.prettyNinja output+    pure (prettyInput, prettyOutput)++  unless (expected == actual) $ do+    -- let actualJ   = Aeson.toJSON actual+    -- let expectedJ = Aeson.toJSON expected+    -- -- LBSC8.putStrLn (Aeson.encodePretty (Aeson.diff actualJ expectedJ))+    -- LBSC8.putStrLn (Aeson.encodePretty expectedJ)+    -- LBSC8.putStrLn (Aeson.encodePretty actualJ)+    -- Aeson.encode actualJ `H.shouldBe` Aeson.encode expectedJ+    Test.assertEqual "prefix" expected actual++compileTest :: AST.Ninja () -> IO ()+compileTest ninja = void $ do+  either (displayException .> fail) pure (Compile.compile ninja)++ninjaTests :: String -> AST.Ninja () -> TestTree+ninjaTests name ninja+  = Test.testGroup (name <> ".ninja")+    [ Test.testCase "compare lexer against reference implementation" $ do+        lexerEquivalentTest name+    , Test.testCase "roundtrip through parser and pretty-printer" $ do+        roundtripTest ninja+    , Test.testCase "compile to Ninja" $ do+        compileTest ninja+    ]++aesonTests :: TestTree+aesonTests+  = Test.testGroup "aeson"+    [ testModule "Language.Ninja.Lexer"+      [ testAesonSC 2   (Ty.Proxy @(Lexer.Lexeme Bool))+      , testAesonSC 4   (Ty.Proxy @(Lexer.LName  Bool))+      , testAesonSC 4   (Ty.Proxy @(Lexer.LFile  Bool))+      , testAesonSC 4   (Ty.Proxy @(Lexer.LBind  Bool))+      , testAesonSC 2   (Ty.Proxy @(Lexer.LBuild Bool))+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.IR.Build"+      [ testAesonSC 2   (Ty.Proxy @IR.Build)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.IR.Meta"+      [ testAesonSC def (Ty.Proxy @IR.Meta)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.IR.Ninja"+      [ testAesonSC 2   (Ty.Proxy @IR.Ninja)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.IR.Pool"+      [ testAesonSC def (Ty.Proxy @IR.Pool)+      , testAesonSC def (Ty.Proxy @IR.PoolName)+      , testAesonSC def (Ty.Proxy @IR.PoolDepth)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.IR.Rule"+      [ testAesonSC 1   (Ty.Proxy @IR.Rule)+      , testAesonSC def (Ty.Proxy @IR.SpecialDeps)+      , testAesonSC def (Ty.Proxy @IR.ResponseFile)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.IR.Target"+      [ testAesonSC def (Ty.Proxy @IR.Target)+      , testAesonSC def (Ty.Proxy @IR.Output)+      , testAesonSC def (Ty.Proxy @IR.Dependency)+      , testAesonSC def (Ty.Proxy @IR.DependencyType)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.AST.Env"+      [ testAesonSC def (Ty.Proxy @(AST.Env Text Text))+      , testAesonQC     (Ty.Proxy @(AST.Env Text Text))+      ]+    , testModule "Language.Ninja.AST.Expr"+      [ testAesonSC def (Ty.Proxy @(AST.Expr Bool))+      , testAesonQC     (Ty.Proxy @(AST.Expr Bool))+      ]+    , testModule "Language.Ninja.AST.Rule"+      [ testAesonSC def (Ty.Proxy @(AST.Rule Bool))+      , testAesonQC     (Ty.Proxy @(AST.Rule Bool))+      ]+    , testModule "Language.Ninja.AST.Ninja"+      [ -- TODO: combinatorial explosion+        testAesonSC 0   (Ty.Proxy @(AST.Ninja Bool))+      -- , testAesonQC     (Ty.Proxy @(AST.Ninja Bool))+      ]+    , testModule "Language.Ninja.AST.Build"+      [ -- TODO: combinatorial explosion+        testAesonSC 1   (Ty.Proxy @(AST.Build Bool))+      -- , testAesonQC     (Ty.Proxy @(AST.Build Bool))+      ]+    , testModule "Language.Ninja.AST.Deps"+      [ testAesonSC def (Ty.Proxy @(AST.Deps Bool))+      , testAesonQC     (Ty.Proxy @(AST.Deps Bool))+      ]+    , testModule "Language.Ninja.Misc.Command"+      [ testAesonSC def (Ty.Proxy @Misc.Command)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.Misc.Path"+      [ testAesonSC def (Ty.Proxy @Misc.Path)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.Misc.Located"+      [ testAesonSC def (Ty.Proxy @(Misc.Located Bool))+      , testAesonSC def (Ty.Proxy @Misc.Position)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    , testModule "Language.Ninja.Misc.IText"+      [ testAesonSC def (Ty.Proxy @Misc.IText)+      -- TODO: add Arbitrary instances so we can testAesonQC+      ]+    ]+  where+    testAesonSC :: forall x.+                   ( Eq x, Show x, Ty.Typeable x, SC.Serial IO x+                   , Aeson.ToJSON x, Aeson.FromJSON x+                   ) => Int -> Ty.Proxy x -> Maybe TestTree+    testAesonSC d p = withDepth d+                      (testType p+                       [Test.testGroup "ToJSON/FromJSON Laws" [aesonSC p]])++    testAesonQC :: forall x.+                   ( Eq x, Show x, Ty.Typeable x, QC.Arbitrary x+                   , Aeson.ToJSON x, Aeson.FromJSON x+                   ) => Ty.Proxy x -> Maybe TestTree+    testAesonQC p = Just (testType p+                          [Test.testGroup "ToJSON/FromJSON Laws" [aesonQC p]])++    withDepth :: Int -> (TestTree -> Maybe TestTree)+    withDepth 0     = const Nothing+    withDepth depth = Test.localOption (Test.SC.SmallCheckDepth depth) .> Just++    testModule :: TestName -> [Maybe TestTree] -> TestTree+    testModule name subtrees = Test.testGroup name (catMaybes subtrees)++    testType :: forall x. (Ty.Typeable x)+             => Ty.Proxy x -> [TestTree] -> TestTree+    testType p subtrees = Test.localOption typeTimeout+                          $ Test.testGroup (printProxy p) subtrees++    printProxy :: forall x. (Ty.Typeable x) => Ty.Proxy x -> String+    printProxy p = Ty.showsTypeRep (Ty.typeRep p) ""++    def :: Int+    def = (Test.defaultValue :: Test.SC.SmallCheckDepth)+          |> toInteger |> fromIntegral++    typeTimeout :: Test.Timeout+    typeTimeout = Test.mkTimeout 20000000 -- 20 seconds++opticsTests :: TestTree+opticsTests+  = Test.testGroup "optics"+    [ testModule "Language.Ninja.IR.Build"+      [ testType "Build" [] -- TODO: combinatorial explosion+        -- [ testLens 1 "buildRule" IR.buildRule+        -- , testLens 1 "buildOuts" IR.buildOuts+        -- , testLens 1 "buildDeps" IR.buildDeps+        -- ]+      ]+    , testModule "Language.Ninja.IR.Meta"+      [ testType "Meta"+        [ testLens def "metaReqVersion" IR.metaReqVersion+        , testLens def "metaBuildDir"   IR.metaBuildDir+        ]+      ]+    , testModule "Language.Ninja.IR.Ninja"+      [ testType "Ninja" [] -- TODO: combinatorial explosion+        -- [ testLens 1 "ninjaMeta"     IR.ninjaMeta+        -- , testLens 1 "ninjaBuilds"   IR.ninjaBuilds+        -- , testLens 1 "ninjaPhonys"   IR.ninjaPhonys+        -- , testLens 1 "ninjaDefaults" IR.ninjaDefaults+        -- , testLens 1 "ninjaPools"    IR.ninjaPools+        -- ]+      ]+    , testModule "Language.Ninja.IR.Pool"+      [ testType "Pool"+        [+        ]+      , testType "PoolName"+        [ testIso def "poolNameText" IR.poolNameText+        ]+      , testType "PoolDepth"+        [ testIso def "poolDepthPositive" IR.poolDepthPositive+        ]+      ]+    , testModule "Language.Ninja.IR.Rule"+      [ testType "Rule" [] -- TODO: combinatorial explosion+        -- [ testLens 1 "ruleName"         IR.ruleName+        -- , testLens 1 "ruleCommand"      IR.ruleCommand+        -- , testLens 1 "ruleDescription"  IR.ruleDescription+        -- , testLens 1 "rulePool"         IR.rulePool+        -- , testLens 1 "ruleDepfile"      IR.ruleDepfile+        -- , testLens 1 "ruleSpecialDeps"  IR.ruleSpecialDeps+        -- , testLens 1 "ruleGenerator"    IR.ruleGenerator+        -- , testLens 1 "ruleRestat"       IR.ruleRestat+        -- , testLens 1 "ruleResponseFile" IR.ruleResponseFile+        -- ]+      , testType "SpecialDeps"+        [ testPrism def "_SpecialDepsGCC"  IR._SpecialDepsGCC+        , testPrism def "_SpecialDepsMSVC" IR._SpecialDepsMSVC+        ]+      , testType "ResponseFile"+        [ testLens def "responseFilePath"    IR.responseFilePath+        , testLens def "responseFileContent" IR.responseFileContent+        ]+      ]+    , testModule "Language.Ninja.IR.Target"+      [ testType "Target"+        [ testIso def "targetIText" IR.targetIText+        , testIso def "targetText"  IR.targetText+        ]+      , testType "Output"+        [ testLens def "outputTarget" IR.outputTarget+        ]+      , testType "Dependency"+        [ testLens def "dependencyTarget" IR.dependencyTarget+        , testLens def "dependencyType"   IR.dependencyType+        ]+      , testType "DependencyType"+        [ testPrism def "_NormalDependency"    IR._NormalDependency+        , testPrism def "_OrderOnlyDependency" IR._OrderOnlyDependency+        ]+      ]+    , testModule "Language.Ninja.AST.Env"+      [ testType "Env"+        [ testIso 1 "fromEnv"+          (AST.fromEnv :: Lens.Iso' (AST.Env Text Int) (AST.Maps Text Int))+        ]+      ]+    , testModule "Language.Ninja.AST.Expr"+      [ testType "Expr"+        [ testPrism 4 "_Exprs" (AST._Exprs @Bool)+        , testPrism 4 "_Lit"   (AST._Lit   @Bool)+        , testPrism 4 "_Var"   (AST._Var   @Bool)+        ]+      ]+    , testModule "Language.Ninja.AST.Rule"+      [ testType "Rule"+        [ testLens 4 "ruleBind" (AST.ruleBind @Bool)+        ]+      ]+    , testModule "Language.Ninja.AST.Ninja"+      [ testType "Ninja" [] -- TODO: combinatorial explosion+        -- [ testLens 1 "ninjaRules"     (AST.ninjaRules     @Bool)+        -- , testLens 1 "ninjaSingles"   (AST.ninjaSingles   @Bool)+        -- , testLens 1 "ninjaMultiples" (AST.ninjaMultiples @Bool)+        -- , testLens 1 "ninjaPhonys"    (AST.ninjaPhonys    @Bool)+        -- , testLens 1 "ninjaDefaults"  (AST.ninjaDefaults  @Bool)+        -- , testLens 1 "ninjaSpecials"  (AST.ninjaSpecials  @Bool)+        -- ]+      ]+    , testModule "Language.Ninja.AST.Build"+      [ testType "Build" [] -- TODO: combinatorial explosion+        -- [ testLens 1 "buildRule" (AST.buildRule @Bool)+        -- , testLens 1 "buildEnv"  (AST.buildEnv  @Bool)+        -- , testLens 1 "buildDeps" (AST.buildDeps @Bool)+        -- , testLens 1 "buildBind" (AST.buildBind @Bool)+        -- ]+      ]+    , testModule "Language.Ninja.AST.Deps"+      [ testType "Deps"+        [ testLens def "depsNormal"    (AST.depsNormal    @Bool)+        , testLens def "depsImplicit"  (AST.depsImplicit  @Bool)+        , testLens def "depsOrderOnly" (AST.depsOrderOnly @Bool)+        ]+      ]+    , testModule "Language.Ninja.Misc.Command"+      [ testType "Command"+        [ testIso def "commandText" Misc.commandText+        ]+      ]+    , testModule "Language.Ninja.Misc.Path"+      [ testType "Path"+        [ testIso def "pathIText"  Misc.pathIText+        , testIso def "pathText"   Misc.pathText+        , testIso def "pathString" Misc.pathString+        , testIso def "pathFP"     Misc.pathFP+        ]+      ]+    , testModule "Language.Ninja.Misc.Located"+      [ testType "Located"+        [ testLens 4 "locatedPos"+          (Misc.locatedPos :: Lens.Lens' (Misc.Located Bool) Misc.Position)+        , testLens 4 "locatedVal"+          (Misc.locatedVal :: Lens.Lens' (Misc.Located Bool) Bool)+        ]+      , testType "Position"+        [ testLens 4 "positionFile" Misc.positionFile+        , testLens 4 "positionLine" Misc.positionLine+        , testLens 4 "positionCol"  Misc.positionCol+        ]+      ]+    , testModule "Language.Ninja.Misc.IText"+      [ testType "IText"+        [ testIso def "itext" Misc.itext+        ]+      ]+    ]+  where+    testIso   :: ( Eq s, Eq a, Show s, Show a+                 , SC.Serial Identity s, SC.Serial IO s, SC.CoSerial IO s+                 , SC.Serial Identity a, SC.Serial IO a, SC.CoSerial IO a+                 ) => Int -> TestName -> Lens.Iso' s a -> TestTree+    testLens  :: ( Eq s, Eq a, Show s, Show a+                 , SC.Serial IO s, SC.Serial IO a+                 , SC.Serial Identity a, SC.CoSerial IO a+                 ) => Int -> TestName -> Lens.Lens' s a -> TestTree+    testPrism :: ( Eq s, Eq a, Show s, Show a+                 , SC.Serial IO s, SC.Serial IO a+                 , SC.Serial Identity a, SC.CoSerial IO a+                 ) => Int -> TestName -> Lens.Prism' s a -> TestTree+    testIso   d name i = withDepth d $ Test.testGroup name [Test.Iso.test   i]+    testLens  d name l = withDepth d $ Test.testGroup name [Test.Lens.test  l]+    testPrism d name p = withDepth d $ Test.testGroup name [Test.Prism.test p]++    withDepth :: Int -> (TestTree -> TestTree)+    withDepth depth = Test.localOption (Test.SC.SmallCheckDepth depth)++    testModule :: TestName -> [TestTree] -> TestTree+    testModule = Test.testGroup++    testType :: TestName -> [TestTree] -> TestTree+    testType name subtrees = Test.localOption typeTimeout+                             $ Test.testGroup name subtrees++    def :: Int+    def = (Test.defaultValue :: Test.SC.SmallCheckDepth)+          |> toInteger |> fromIntegral++    typeTimeout :: Test.Timeout+    typeTimeout = Test.mkTimeout 20000000 -- 20 seconds++ingredients :: IO [Test.Ingredient]+ingredients = [ [Test.htmlRunner]+              , Test.defaultIngredients+              ] |> mconcat |> pure++testTree :: IO TestTree+testTree = do+  ninjas <- forM testFiles parseTestNinja++  haddockTests <- Lint.emptyLintHaddockOptions+                  |> Lint.addComponentName "language-ninja"+                  |> Lint.lintHaddock++  let tests = Test.testGroup "language-ninja"+              [ Test.testGroup "golden"+                 (fmap (uncurry ninjaTests) (zip testFiles ninjas))+              , aesonTests+              , opticsTests+              , haddockTests+              ]+  pure tests++test :: IO ()+test = do+  is <- ingredients+  tree <- testTree+  Test.defaultMainWithIngredients is tree++main :: IO ()+main = do+  test++--------------------------------------------------------------------------------
+ tests/Tests/Lint.hs view
@@ -0,0 +1,240 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: tests/Tests/Lint.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.++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE RecordWildCards       #-}++-- |+--   Module      : Tests.Lint+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Tests that involve linting the project.+--   In particular, Haddock linting is currently supported.+module Tests.Lint+  ( lintHaddock++  , LintHaddockOptions+  , emptyLintHaddockOptions+  , addComponentName, addSinceException, addHaddockArgument+  , modifyComponentNames, modifySinceExceptions, modifyHaddockArguments++  , ComponentName, SinceException+  ) where++import           Control.Applicative         (empty)+import           Control.Arrow               ((&&&))+import           Control.Monad               (forM)++import           Data.Functor.Identity       (runIdentity)+import           Data.Maybe                  (catMaybes, isJust)+import           Data.Monoid                 ((<>))++import           Flow                        ((.>), (|>))++import qualified GHC+import qualified Outputable                  as GHC++import qualified Data.Map.Lazy               as LMap++import qualified Data.Text                   as Text++import qualified Documentation.Haddock       as H+import qualified Documentation.Haddock.Types as H++-- import qualified Documentation.Haddock.Doc          as H.Doc+-- import qualified Documentation.Haddock.Parser       as H.Parser+-- import qualified Documentation.Haddock.Parser.Monad as H.Parser++import qualified Test.Tasty                  as Test+import qualified Test.Tasty.HUnit            as Test++import qualified Turtle++--------------------------------------------------------------------------------++-- | Generate and lint the Haddock documentation for this project.+lintHaddock :: LintHaddockOptions -> IO Test.TestTree+lintHaddock options = do+  _ <- H.withGhc [] GHC.getSessionDynFlags+  buildHaddock+  mapM (lintInterfaceFile options) (componentNames options)+    |> fmap (Test.testGroup "Haddock linting")++--------------------------------------------------------------------------------++-- | A type for options provided to 'lintHaddock'.+data LintHaddockOptions+  = MkLintHaddockOptions+    { componentNames   :: [ComponentName]+    , sinceExceptions  :: [SinceException]+    , haddockArguments :: [String]+    }+  deriving (Eq, Show)++-- | An empty 'LintHaddockOptions'.+emptyLintHaddockOptions :: LintHaddockOptions+emptyLintHaddockOptions = MkLintHaddockOptions [] [] []++-- | Add the given 'ComponentName' to the given 'LintHaddockOptions'.+addComponentName :: ComponentName+                 -> (LintHaddockOptions -> LintHaddockOptions)+addComponentName cn = modifyComponentNames (cn :)++-- | Add the given 'SinceException' to the given 'LintHaddockOptions'.+addSinceException :: SinceException+                  -> (LintHaddockOptions -> LintHaddockOptions)+addSinceException se = modifySinceExceptions (se :)++-- | Add the given Haddock argument to the given 'LintHaddockOptions'.+addHaddockArgument :: String+                   -> (LintHaddockOptions -> LintHaddockOptions)+addHaddockArgument arg = modifyHaddockArguments (arg :)++-- | Modify the list of 'ComponentName's with the given function.+modifyComponentNames :: ([ComponentName] -> [ComponentName])+                     -> (LintHaddockOptions -> LintHaddockOptions)+modifyComponentNames f (MkLintHaddockOptions {..})+  = MkLintHaddockOptions { componentNames = f componentNames, .. }++-- | Modify the list of 'SinceException's with the given function.+modifySinceExceptions :: ([SinceException] -> [SinceException])+                      -> (LintHaddockOptions -> LintHaddockOptions)+modifySinceExceptions f (MkLintHaddockOptions {..})+  = MkLintHaddockOptions { sinceExceptions = f sinceExceptions, .. }++-- | Modify the list of Haddock arguments with the given function.+modifyHaddockArguments :: ([String] -> [String])+                       -> (LintHaddockOptions -> LintHaddockOptions)+modifyHaddockArguments f (MkLintHaddockOptions {..})+  = MkLintHaddockOptions { haddockArguments = f haddockArguments, .. }++--------------------------------------------------------------------------------++-- | The name of a Cabal component for which the Haddock documentation should+--   be linted.+type ComponentName = String++-- | An exception to the checker that ensures that every top-level exposed+--   declaration has an @\@since@ attribute; this takes the form of a+--   fully-qualified Haskell name, e.g.: @Control.Monad.unless@.+type SinceException = String++--------------------------------------------------------------------------------++lintInterfaceFile :: LintHaddockOptions -> ComponentName -> IO Test.TestTree+lintInterfaceFile options cn+  = readInterface ifaceFP+    >>= snd+    .>  map ((id &&& deconstruct) .> uncurry helper)+    .>  Test.testGroup cn+    .>  pure+  where+    ifaceFP :: FilePath+    ifaceFP = "./dist/doc/html/" <> cn <> "/" <> cn <> ".haddock"++    helper :: H.InstalledInterface -> [(Ident, H.MDoc Ident)] -> Test.TestTree+    helper iface xs = do+      let ifaceName = H.instMod iface+                      |> GHC.moduleName+                      |> GHC.moduleNameString+      Test.testGroup ifaceName (map (checkSince options) xs)++checkSince :: LintHaddockOptions -> (Ident, H.MDoc Ident) -> Test.TestTree+checkSince options (ident, mdoc)+  = if qname `elem` sinceExceptions options+    then (Test.testCaseInfo name (pure (qname <> " is in exceptions list")))+    else (Test.testCase name+          (Test.assertBool message (hasSince mdoc)))+  where+    name = printIdentName ident+    qname = printIdent ident+    message = qname <> " does not have @since"++readInterface :: FilePath -> IO (H.LinkEnv, [H.InstalledInterface])+readInterface fp = H.readInterfaceFile H.freshNameCache fp+                   >>= either fail (decomposeIF .> pure)+  where+    decomposeIF = H.ifLinkEnv &&& H.ifInstalledIfaces++buildHaddock :: IO ()+buildHaddock = runHaddock []+  where+    runHaddock :: [String] -> IO ()+    runHaddock extraArgs = Turtle.sh $ do+      let args = ["./Setup.hs", "haddock"] ++ map Text.pack extraArgs+      Turtle.inprocWithErr "runhaskell" args empty++deconstruct :: H.InstalledInterface -> [(Ident, H.MDoc Ident)]+deconstruct iface+  = (catMaybes $ runIdentity $ forM exports+     $ \name -> do let ident = toIdent name+                   LMap.lookup name docmap+                     |> fmap (\doc -> (ident, toIdent <$> doc))+                     |> pure)+    -- maybe (fail ("could not find: " <> printIdent ident)) pure+    -- pure (ident, toIdent <$> doc)+  where+    exports = H.instVisibleExports iface+    docmap  = H.instDocMap iface+    toIdent = MkIdent (H.instMod iface)++--------------------------------------------------------------------------------++data Ident+  = MkIdent+    { _identModule :: !GHC.Module+    , _identName   :: !GHC.Name+    }+  deriving ()++printIdentModule :: Ident -> String+printIdentModule (MkIdent {..})+  = GHC.moduleNameString (GHC.moduleName _identModule)++-- NOTE: this fails if the GHC dynflags have not been set up+printIdentName :: Ident -> String+printIdentName (MkIdent {..})+  = GHC.showSDocUnsafe (GHC.ppr _identName)++printIdent :: Ident -> String+printIdent ident = printIdentModule ident <> "." <> printIdentName ident++instance Show Ident where+  show = printIdent++--------------------------------------------------------------------------------++class HasSince t where+  hasSince :: t -> Bool++instance HasSince (H.MDoc name) where+  hasSince = H._meta .> H._version .> isJust++instance HasSince (H.Documentation name) where+  hasSince = H.documentationDoc .> maybe False hasSince++--------------------------------------------------------------------------------
+ tests/Tests/Mock.hs view
@@ -0,0 +1,66 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: tests/Tests/Mock.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.++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE StandaloneDeriving    #-}++-- |+--   Module      : Tests.Mock+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains concrete types that are used when mocking interfaces+--   defined in "Language.Ninja.Mock".+module Tests.Mock+  ( FSAction (..)+  ) where++import           Data.Text                    (Text)++import           Language.Ninja.Misc.Path     (Path)+import           Language.Ninja.Mock.ReadFile (MonadReadFile (..))++import qualified Control.Monad.Mock           as Mock+import           Data.Type.Equality           ((:~:) (Refl))++--------------------------------------------------------------------------------++data FSAction r where+  ReadFile  :: !Path          -> FSAction Text+  WriteFile :: !Path -> !Text -> FSAction ()++deriving instance Eq (FSAction r)+deriving instance Show (FSAction r)++instance Mock.Action FSAction where+  eqAction (a@(ReadFile  {})) (b@(ReadFile  {})) | (a == b) = Just Refl+  eqAction (a@(WriteFile {})) (b@(WriteFile {})) | (a == b) = Just Refl+  eqAction _                  _                             = Nothing++instance (Monad m) => MonadReadFile (Mock.MockT FSAction m) where+  readFile path = Mock.mockAction "readFile" (ReadFile path)++--------------------------------------------------------------------------------
+ tests/Tests/Orphans.hs view
@@ -0,0 +1,184 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: tests/Tests.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 -Wno-orphans #-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++-- |+--   Module      : Main+--   Copyright   : Copyright 2017 Awake Security+--   License     : Apache-2.0+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   This module contains orphan instances used in testing.+module Tests.Orphans+  ( -- No exports other than instances.+  ) where++import           Data.Hashable             (Hashable)++import qualified Data.HashMap.Strict       as HM+import qualified Data.HashSet              as HS+import qualified Data.List.NonEmpty        as NE+import qualified Data.Text                 as Text+import qualified Data.Versions             as Ver+import qualified Filesystem.Path.CurrentOS as FP++import           Test.SmallCheck.Series    ((<~>), (>>-), (\/))+import qualified Test.SmallCheck.Series    as SC++import           Flow                      ((.>), (|>))++--------------------------------------------------------------------------------++instance ( Monad m, SC.Serial m k, SC.Serial m v, Hashable k+         ) => SC.Serial m (HM.HashMap k v) where+  series = pure HM.empty+           \/ (HM.singleton <$> SC.series <~> SC.series)+           -- \/ (HM.union <$> SC.series <~> SC.series)++instance ( Monad m, SC.CoSerial m k, SC.CoSerial m v+         ) => SC.CoSerial m (HM.HashMap k v) where+  coseries = SC.coseries .> fmap (\f -> HM.toList .> f)++--------------------------------------------------------------------------------++instance ( Monad m, SC.Serial m a, Hashable a+         ) => SC.Serial m (HS.HashSet a) where+  series = pure HS.empty+           \/ (HS.singleton <$> SC.series)+           -- \/ (HS.union <$> SC.series <~> SC.series)++instance (Monad m, SC.CoSerial m a) => SC.CoSerial m (HS.HashSet a) where+  coseries = SC.coseries .> fmap (\f -> HS.toList .> f)++--------------------------------------------------------------------------------++instance (Monad m, SC.Serial m a) => SC.Serial m (NE.NonEmpty a) where+  series = SC.series |> fmap (pure .> NE.fromList)+  -- series = SC.series |> fmap (SC.getNonEmpty .> NE.fromList)++instance (Monad m, SC.CoSerial m a) => SC.CoSerial m (NE.NonEmpty a) where+  coseries = SC.coseries .> fmap (\f -> NE.toList .> f)++--------------------------------------------------------------------------------++instance (Monad m) => SC.Serial m Text.Text where+  series = foldr1 (\/) (map pure testText)++instance (Monad m) => SC.CoSerial m Text.Text where+  coseries rs = SC.alts0 rs >>- \y -> SC.alts2 rs >>- \f -> do+    pure (Text.uncons .> (\case Nothing        -> y+                                (Just (b, bs)) -> f (Text.singleton b) bs))++--------------------------------------------------------------------------------++instance (Monad m) => SC.Serial m FP.FilePath where+  series = foldr1 (\/) (map pure testFP)++instance (Monad m) => SC.CoSerial m FP.FilePath where+  coseries = SC.coseries .> (fmap (\f -> FP.encodeString .> Text.pack .> f))++--------------------------------------------------------------------------------++instance (Monad m) => SC.Serial m Ver.Version where+  series = foldr1 (\/) (map pure testVersions)++instance (Monad m, SC.CoSerial m Ver.VUnit) => SC.CoSerial m Ver.Version where+  coseries = SC.coseries .> fmap (\f -> toTuple .> f)+    where+      toTuple (Ver.Version {..}) = (_vEpoch, _vChunks, _vRel)++instance (Monad m) => SC.CoSerial m Ver.VUnit where+  coseries = SC.coseries+             .> fmap (\f -> \case (Ver.Digits i) -> f (Right i)+                                  (Ver.Str    s) -> f (Left  s))++--------------------------------------------------------------------------------++testText :: [Text.Text]+testText = ["", "foo", "42", " "]++testFP :: [FP.FilePath]+testFP = ["/foo/bar", ".", "..", "foo", "foo/", "/foo/", "/foo//bar"]++testVersions :: [Ver.Version]+testVersions = [ "0.1.0"+               , "0.2"+               , "0.2.0"+               , "0.2.0.0"+               , "0.25-2"+               , "0.9.9.9"+               , "1"+               , "1.0"+               , "1.0.0"+               , "1.0.0.0"+               , "1.0.0.1"+               , "1.0.0-alpha"+               , "1.0.0-alpha.1"+               , "1.0.0-alpha.beta"+               , "1.0.0-beta"+               , "1.0.0-beta.11"+               , "1.0.0-beta.2"+               , "1.0.0-rc.1"+               , "1:0.10.16-3"+               , "1.0rc0"+               , "1.0rc1"+               , "1.1"+               , "1:1.0"+               , "1:1.1"+               , "1:1.2.3-1"+               , "1.1rc1"+               , "1.2"+               , "1.2.2r1-1"+               , "1.2.3"+               , "1.2.3-1"+               , "1.2.3-alpha"+               , "1.2.3-alpha.2"+               , "1.2.3r1"+               , "1.2.3r1-1"+               , "1.2.4"+               , "1.2.4r1-1"+               , "1.2-5"+               , "1.58.0-3"+               , "2"+               , "20150826-1"+               , "21-2"+               , "2.3.4"+               , "3.4.5"+               , "44.0.2403.157-1"+               , "7.1p1-1"+               , "8.u51-1"+               ] |> map (Ver.version .> fromRight)+  where+    fromRight :: (Show a, Show b) => Either a b -> b+    fromRight (Left  a) = error ("fromRight: " ++ show a)+    fromRight (Right b) = b++--------------------------------------------------------------------------------
+ tests/Tests/ReferenceLexer.hs view
@@ -0,0 +1,304 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: tests/Tests/ReferenceLexer.hs+--+-- License:+--     Copyright Neil Mitchell  2011-2017.+--     Copyright Awake Security 2017.+--     All rights reserved.+--+--     Redistribution and use in source and binary forms, with or without+--     modification, are permitted provided that the following conditions are+--     met:+--+--         * Redistributions of source code must retain the above copyright+--           notice, this list of conditions and the following disclaimer.+--+--         * Redistributions in binary form must reproduce the above+--           copyright notice, this list of conditions and the following+--           disclaimer in the documentation and/or other materials provided+--           with the distribution.+--+--         * Neither the name of Neil Mitchell nor the names of other+--           contributors may be used to endorse or promote products derived+--           from this software without specific prior written permission.+--+--     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+--     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+--     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+--     A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+--     OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+--     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+--     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+--     DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+--     THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+--     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+--     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE PatternGuards         #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ViewPatterns          #-}++-- |+--   Module      : Tests.ReferenceLexer+--   Copyright   : Copyright 2011-2017 Neil Mitchell+--   License     : BSD3+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   Lexing is a slow point, the code below is optimised.+module Tests.ReferenceLexer+  ( -- * Lexing+    lexFile, lexText, lexBS++    -- * Types+  , Lexer.Lexeme (..)+  , Lexer.LName  (..)+  , Lexer.LFile  (..)+  , Lexer.LBind  (..)+  , Lexer.LBuild (..)+  ) where++import           Control.Arrow             (first)+import           Control.Monad.Error.Class (MonadError)++import qualified Data.ByteString.Char8     as BSC8++import           Data.Text                 (Text)+import qualified Data.Text                 as Text+import qualified Data.Text.Encoding        as Text++import           Data.Char                 (isAsciiLower, isAsciiUpper, isDigit)++import           Flow                      ((.>), (|>))++import qualified Language.Ninja.AST        as AST+import qualified Language.Ninja.Errors     as Errors+import qualified Language.Ninja.Misc       as Misc+import qualified Language.Ninja.Mock       as Mock++import qualified Language.Ninja.Lexer      as Lexer++import           Tests.ReferenceLexer.Str0 (Str0 (MkStr0))+import qualified Tests.ReferenceLexer.Str0 as Str0++--------------------------------------------------------------------------------++type Str = BSC8.ByteString++-- | Lex the given file.+lexFile :: (MonadError Errors.ParseError m, Mock.MonadReadFile m)+          => Misc.Path -> m [Lexer.Lexeme ()]+lexFile file = Mock.readFile file >>= lexText++-- | Lex the given 'Text'.+lexText :: (MonadError Errors.ParseError m)+          => Text -> m [Lexer.Lexeme ()]+lexText = Text.encodeUtf8 .> lexBS++-- | Lex the given 'BSC8.ByteString'.+lexBS :: (MonadError Errors.ParseError m)+        => BSC8.ByteString -> m [Lexer.Lexeme ()]+lexBS x = lexerLoop (MkStr0 (BSC8.append x "\n\n\0"))++--------------------------------------------------------------------------------++lexerLoop :: (MonadError Errors.ParseError m) => Str0 -> m [Lexer.Lexeme ()]+lexerLoop c_x+  = case c of+      '\r'                                  -> lexerLoop x0+      '\n'                                  -> lexerLoop x0+      '#'                                   -> lexerLoop $ removeComment x0+      ' '                                   -> lexBind     $ dropSpace x0+      'b'  | Just x1 <- strip "uild "    x0 -> lexBuild    $ dropSpace x1+      'r'  | Just x1 <- strip "ule "     x0 -> lexRule     $ dropSpace x1+      'd'  | Just x1 <- strip "efault "  x0 -> lexDefault  $ dropSpace x1+      'p'  | Just x1 <- strip "ool "     x0 -> lexPool     $ dropSpace x1+      'i'  | Just x1 <- strip "nclude "  x0 -> lexInclude  $ dropSpace x1+      's'  | Just x1 <- strip "ubninja " x0 -> lexSubninja $ dropSpace x1+      '\0'                                  -> pure []+      _                                     -> lexDefine c_x+  where+    removeComment = Str0.dropWhile0 (/= '\n')++    (c, x0) = Str0.list0 c_x++    strip str (MkStr0 x) = let b = BSC8.pack str+                           in if b `BSC8.isPrefixOf` x+                              then Just $ MkStr0 $ BSC8.drop (BSC8.length b) x+                              else Nothing++lexBind :: (MonadError Errors.ParseError m) => Str0 -> m [Lexer.Lexeme ()]+lexBind c_x | (c, x) <- Str0.list0 c_x+  = case c of+      '\r' -> lexerLoop x+      '\n' -> lexerLoop x+      '#'  -> lexerLoop $ Str0.dropWhile0 (/= '\n') x+      '\0' -> pure []+      _    -> lexxBind (Lexer.LexBind ()) c_x++lexBuild :: (MonadError Errors.ParseError m) => Str0 -> m [Lexer.Lexeme ()]+lexBuild x0 = do+  (outputs, x1) <- lexxExprs True x0+  let (rule, x2) = Str0.span0 isVarDot $ dropSpace x1+  (deps, x3) <- lexxExprs False $ dropSpace x2+  x4 <- lexerLoop x3+  let name = Lexer.MkLName () rule+  pure (Lexer.LexBuild () (Lexer.makeLBuild () outputs name deps) : x4)++lexDefault :: (MonadError Errors.ParseError m) => Str0 -> m [Lexer.Lexeme ()]+lexDefault str0 = do+  (files, str1) <- lexxExprs False str0+  str2 <- lexerLoop str1+  pure (Lexer.LexDefault () files : str2)++lexRule, lexPool, lexInclude, lexSubninja, lexDefine+  :: (MonadError Errors.ParseError m) => Str0 -> m [Lexer.Lexeme ()]+lexRule     = lexxName (Lexer.LexRule     ())+lexPool     = lexxName (Lexer.LexPool     ())+lexInclude  = lexxFile (Lexer.LexInclude  ())+lexSubninja = lexxFile (Lexer.LexSubninja ())+lexDefine   = lexxBind (Lexer.LexDefine   ())++lexxBind :: (MonadError Errors.ParseError m)+         => (Lexer.LBind () -> Lexer.Lexeme ()) -> Str0 -> m [Lexer.Lexeme ()]+lexxBind ctor x0 = do+  let (var,  x1) = Str0.span0 isVarDot x0+  let (eq,   x2) = Str0.list0 $ dropSpace x1+  (expr, x3) <- lexxExpr False False $ dropSpace x2+  x4         <- lexerLoop x3+  if (eq == '=')+    then pure (ctor (Lexer.MkLBind () (Lexer.MkLName () var) expr) : x4)+    else Errors.throwLexBindingFailure (Text.pack (show (Str0.take0 100 x0)))++lexxFile :: (MonadError Errors.ParseError m)+         => (Lexer.LFile () -> Lexer.Lexeme ()) -> Str0 -> m [Lexer.Lexeme ()]+lexxFile ctor str0 = do+  (expr, str1) <- lexxExpr False False (dropSpace str0)+  str2         <- lexerLoop str1+  pure (ctor (Lexer.MkLFile expr) : str2)++lexxName :: (MonadError Errors.ParseError m)+         => (Lexer.LName () -> Lexer.Lexeme ()) -> Str0 -> m [Lexer.Lexeme ()]+lexxName ctor x = do+  let (name, rest) = splitLineCont x+  lexemes <- lexerLoop rest+  pure (ctor (Lexer.MkLName () name) : lexemes)++lexxExprs :: (MonadError Errors.ParseError m)+          => Bool -> Str0 -> m ([AST.Expr ()], Str0)+lexxExprs sColon x0 = do+  (a, c_x) <- lexxExpr sColon True x0+  let c  = Str0.head0 c_x+  let x1 = Str0.tail0 c_x+  case c of+    ' '           -> do (exprs, x2) <- lexxExprs sColon $ dropSpace x1+                        pure (a:exprs, x2)+    ':'  | sColon -> pure ([a], x1)+    _    | sColon -> Errors.throwLexExpectedColon+    '\r'          -> pure (a $: dropN x1)+    '\n'          -> pure (a $: x1)+    '\0'          -> pure (a $: c_x)+    _             -> Errors.throwLexUnexpectedSeparator c+  where+    ($:) :: AST.Expr () -> Str0 -> ([AST.Expr ()], Str0)+    (AST.Exprs () []) $: s = ([],     s)+    expr              $: s = ([expr], s)++{-# NOINLINE lexxExpr #-}+lexxExpr :: (MonadError Errors.ParseError m)+         => Bool+         -- ^ @stopColon@+         -> Bool+         -- ^ @stopSpace@+         -> Str0+         -- ^ The input bytestring+         -> m (AST.Expr (), Str0)+         -- ^ The second field will start with one of @" :\n\r"@ or be empty+lexxExpr stopColon stopSpace str0 = first exprs <$> f str0+  where+    exprs :: [AST.Expr ()] -> AST.Expr ()+    exprs [x] = AST.normalizeExpr x+    exprs xs  = AST.normalizeExpr (AST.Exprs () xs)++    special :: Char -> Bool+    special x = let b = x `elem` ['$', '\r', '\n', '\0']+                in case (stopColon, stopSpace) of+                     (True , True ) -> (x <= ':') && or [x == ':', x == ' ', b]+                     (True , False) -> (x <= ':') && or [x == ':',           b]+                     (False, True ) -> (x <= '$') && or [          x == ' ', b]+                     (False, False) -> (x <= '$') && or [                    b]++    f :: (MonadError Errors.ParseError m) => Str0 -> m ([AST.Expr ()], Str0)+    f (Str0.break00 special -> (a, x))+      = if BSC8.null a+        then g x+        else g x >>= \y -> pure (AST.Lit () (Text.decodeUtf8 a) $: y)++    g :: (MonadError Errors.ParseError m) => Str0 -> m ([AST.Expr ()], Str0)+    g x0 | (Str0.head0 x0 /= '$') = pure ([], x0)+    g (Str0.tail0 -> c_x) =+      let (c, x0) = Str0.list0 c_x+      in case c of+           '$'   -> f x0 >>= (AST.Lit () "$" $:) .> pure+           ' '   -> f x0 >>= (AST.Lit () " " $:) .> pure+           ':'   -> f x0 >>= (AST.Lit () ":" $:) .> pure+           '\n'  -> f (dropSpace x0)+           '\r'  -> f (dropSpace (dropN x0))+           '{' | (name, x1) <- Str0.span0 isVarDot x0+               , ('}',  x2) <- Str0.list0 x1+               , not (BSC8.null name)+                 -> f x2 >>= (AST.Var () (Text.decodeUtf8 name) $:) .> pure+           _   | (name, x1) <- Str0.span0 isVar c_x+               , not $ BSC8.null name+                 -> f x1 >>= (AST.Var () (Text.decodeUtf8 name) $:) .> pure+           _     -> Errors.throwLexUnexpectedDollar++    ($:) :: a -> ([a], b) -> ([a], b)+    x $: (xs, y) = (x:xs, y)++splitLineCont :: Str0 -> (Str, Str0)+splitLineCont = go .> first BSC8.concat+  where+    go = splitLineCR .> go'++    go' (a, b) | not (endsDollar a) = ([a], b)+               | otherwise          = let (c, d) = go (dropSpace b)+                                      in (BSC8.init a : c, d)++splitLineCR :: Str0 -> (Str, Str0)+splitLineCR x = if BSC8.isSuffixOf (BSC8.singleton '\r') a+                then (BSC8.init a, dropN b)+                else (a, dropN b)+  where+    (a, b) = Str0.break0 (== '\n') x++isVar :: Char -> Bool+isVar x = [ (x == '-')+          , (x == '_')+          , isAsciiLower x+          , isAsciiUpper x+          , isDigit x+          ] |> or++isVarDot :: Char -> Bool+isVarDot x = [ x == '.'+             , isVar x+             ] |> or++endsDollar :: Str -> Bool+endsDollar = BSC8.isSuffixOf (BSC8.singleton '$')++dropN :: Str0 -> Str0+dropN x = if (Str0.head0 x == '\n')+          then Str0.tail0 x+          else x++dropSpace :: Str0 -> Str0+dropSpace = Str0.dropWhile0 (== ' ')++--------------------------------------------------------------------------------
+ tests/Tests/ReferenceLexer/Str0.hs view
@@ -0,0 +1,127 @@+-- -*- coding: utf-8; mode: haskell; -*-++-- File: tests/Tests/ReferenceLexer/Str0.hs+--+-- License:+--     Copyright Neil Mitchell  2011-2017.+--     Copyright Awake Security 2017.+--     All rights reserved.+--+--     Redistribution and use in source and binary forms, with or without+--     modification, are permitted provided that the following conditions are+--     met:+--+--         * Redistributions of source code must retain the above copyright+--           notice, this list of conditions and the following disclaimer.+--+--         * Redistributions in binary form must reproduce the above+--           copyright notice, this list of conditions and the following+--           disclaimer in the documentation and/or other materials provided+--           with the distribution.+--+--         * Neither the name of Neil Mitchell nor the names of other+--           contributors may be used to endorse or promote products derived+--           from this software without specific prior written permission.+--+--     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+--     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+--     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+--     A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+--     OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+--     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+--     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+--     DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+--     THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+--     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+--     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-- |+--   Module      : Tests.ReferenceLexer.Str0+--   Copyright   : Copyright 2011-2017 Neil Mitchell+--   License     : BSD3+--   Maintainer  : opensource@awakesecurity.com+--   Stability   : experimental+--+--   A NUL-terminated bytestring type used in the reference lexer.+module Tests.ReferenceLexer.Str0+  ( Str0 (..)+  , break0, break00, dropWhile0, head0, list0, span0, tail0, take0+  ) where++import           Data.ByteString          (ByteString)+import qualified Data.ByteString.Char8    as BSC8+import qualified Data.ByteString.Internal as BS.Internal+import qualified Data.ByteString.Unsafe   as BS.Unsafe++import           Data.Word                (Word8)+import qualified Foreign.Ptr+import qualified Foreign.Storable+import           GHC.Exts                 (Ptr (Ptr))+import           System.IO.Unsafe         (unsafePerformIO)++--------------------------------------------------------------------------------++-- | A null-terminated strict bytestring.+newtype Str0+  = MkStr0 ByteString++-- | Convert a pointer to a 'Word8' to a 'Char'.+--+--   TODO: uses unsafePerformIO+char :: Ptr Word8 -> Char+char x = BS.Internal.w2c $ unsafePerformIO $ Foreign.Storable.peek x++-- | Increment a pointer by one byte.+next :: Ptr Word8 -> Ptr Word8+next x = x `Foreign.Ptr.plusPtr` 1++-- | Similar to 'BSC8.dropWhile', but for null-terminated bytestrings.+{-# INLINE dropWhile0 #-}+dropWhile0 :: (Char -> Bool) -> Str0 -> Str0+dropWhile0 f x = snd $ span0 f x++-- | Similar to 'BSC8.span', but for null-terminated bytestrings.+{-# INLINE span0 #-}+span0 :: (Char -> Bool) -> Str0 -> (ByteString, Str0)+span0 f = break0 (not . f)++-- | Similar to 'BSC8.break', but for null-terminated bytestrings.+{-# INLINE break0 #-}+break0 :: (Char -> Bool) -> Str0 -> (ByteString, Str0)+break0 f = break00 (\c -> (c == '\0') || f c)++-- | Similar to 'break0', but it assumes that the given predicate will return+--   true for @'\0'@, allowing it to be slightly faster.+{-# INLINE break00 #-}+break00 :: (Char -> Bool) -> Str0 -> (ByteString, Str0)+break00 f (MkStr0 bs) = (initial, rest)+  where+    initial = BS.Unsafe.unsafeTake i bs+    rest    = MkStr0 $ BS.Unsafe.unsafeDrop i bs++    i = System.IO.Unsafe.unsafePerformIO $+      BS.Unsafe.unsafeUseAsCString bs $ \ptr -> do+      let start = Foreign.Ptr.castPtr ptr :: Ptr Word8+      let end = go start+      pure $! Ptr end `Foreign.Ptr.minusPtr` start++    go s@(Ptr a) | f (char s) = a+                 | otherwise  = go (next s)++-- | Similar to 'BSC8.head', but for null-terminated bytestrings.+head0 :: Str0 -> Char+head0 (MkStr0 x) = BS.Internal.w2c $ BS.Unsafe.unsafeHead x++-- | Similar to 'BSC8.tail', but for null-terminated bytestrings.+tail0 :: Str0 -> Str0+tail0 (MkStr0 x) = MkStr0 $ BS.Unsafe.unsafeTail x++-- | Similar to 'BSC8.uncons', but for null-terminated bytestrings.+list0 :: Str0 -> (Char, Str0)+list0 x = (head0 x, tail0 x)++-- | Similar to 'BSC8.take', but for null-terminated bytestrings.+take0 :: Int -> Str0 -> ByteString+take0 i (MkStr0 x) = BSC8.takeWhile (/= '\0') $ BSC8.take i x++--------------------------------------------------------------------------------