extensions (empty) → 0.0.0.0
raw patch · 16 files changed
+2785/−0 lines, 16 filesdep +Cabaldep +basedep +bytestring
Dependencies added: Cabal, base, bytestring, colourista, containers, directory, extensions, filepath, ghc-boot-th, hedgehog, hspec, hspec-hedgehog, optparse-applicative, parsec, text
Files
- CHANGELOG.md +11/−0
- LICENSE +373/−0
- README.md +120/−0
- app/Cli.hs +71/−0
- app/Main.hs +168/−0
- extensions.cabal +112/−0
- src/Extensions.hs +63/−0
- src/Extensions/Cabal.hs +360/−0
- src/Extensions/Module.hs +214/−0
- src/Extensions/Package.hs +189/−0
- src/Extensions/Types.hs +270/−0
- test/Spec.hs +16/−0
- test/Test/Extensions.hs +98/−0
- test/Test/Extensions/Cabal.hs +229/−0
- test/Test/Extensions/Module.hs +427/−0
- test/Test/Extensions/Types.hs +64/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog++`extensions` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++## 0.0.0.0 — May the 4th, 2020 💪++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/kowainik/extensions/releases
+ LICENSE view
@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+ means each individual or legal entity that creates, contributes to+ the creation of, or owns Covered Software.++1.2. "Contributor Version"+ means the combination of the Contributions of others (if any) used+ by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+ means Covered Software of a particular Contributor.++1.4. "Covered Software"+ means Source Code Form to which the initial Contributor has attached+ the notice in Exhibit A, the Executable Form of such Source Code+ Form, and Modifications of such Source Code Form, in each case+ including portions thereof.++1.5. "Incompatible With Secondary Licenses"+ means++ (a) that the initial Contributor has attached the notice described+ in Exhibit B to the Covered Software; or++ (b) that the Covered Software was made available under the terms of+ version 1.1 or earlier of the License, but not also under the+ terms of a Secondary License.++1.6. "Executable Form"+ means any form of the work other than Source Code Form.++1.7. "Larger Work"+ means a work that combines Covered Software with other material, in+ a separate file or files, that is not Covered Software.++1.8. "License"+ means this document.++1.9. "Licensable"+ means having the right to grant, to the maximum extent possible,+ whether at the time of the initial grant or subsequently, any and+ all of the rights conveyed by this License.++1.10. "Modifications"+ means any of the following:++ (a) any file in Source Code Form that results from an addition to,+ deletion from, or modification of the contents of Covered+ Software; or++ (b) any new file in Source Code Form that contains any Covered+ Software.++1.11. "Patent Claims" of a Contributor+ means any patent claim(s), including without limitation, method,+ process, and apparatus claims, in any patent Licensable by such+ Contributor that would be infringed, but for the grant of the+ License, by the making, using, selling, offering for sale, having+ made, import, or transfer of either its Contributions or its+ Contributor Version.++1.12. "Secondary License"+ means either the GNU General Public License, Version 2.0, the GNU+ Lesser General Public License, Version 2.1, the GNU Affero General+ Public License, Version 3.0, or any later versions of those+ licenses.++1.13. "Source Code Form"+ means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+ means an individual or a legal entity exercising rights under this+ License. For legal entities, "You" includes any entity that+ controls, is controlled by, or is under common control with You. For+ purposes of this definition, "control" means (a) the power, direct+ or indirect, to cause the direction or management of such entity,+ whether by contract or otherwise, or (b) ownership of more than+ fifty percent (50%) of the outstanding shares or beneficial+ ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+ Licensable by such Contributor to use, reproduce, make available,+ modify, display, perform, distribute, and otherwise exploit its+ Contributions, either on an unmodified basis, with Modifications, or+ as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+ for sale, have made, import, and otherwise transfer either its+ Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+ or++(b) for infringements caused by: (i) Your and any other third party's+ modifications of Covered Software, or (ii) the combination of its+ Contributions with other software (except as part of its Contributor+ Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+ its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+ Form, as described in Section 3.1, and You must inform recipients of+ the Executable Form how they can obtain a copy of such Source Code+ Form by reasonable means in a timely manner, at a charge no more+ than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+ License, or sublicense it under different terms, provided that the+ license for the Executable Form does not attempt to limit or alter+ the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+* *+* 6. Disclaimer of Warranty *+* ------------------------- *+* *+* Covered Software is provided under this License on an "as is" *+* basis, without warranty of any kind, either expressed, implied, or *+* statutory, including, without limitation, warranties that the *+* Covered Software is free of defects, merchantable, fit for a *+* particular purpose or non-infringing. The entire risk as to the *+* quality and performance of the Covered Software is with You. *+* Should any Covered Software prove defective in any respect, You *+* (not any Contributor) assume the cost of any necessary servicing, *+* repair, or correction. This disclaimer of warranty constitutes an *+* essential part of this License. No use of any Covered Software is *+* authorized under this License except under this disclaimer. *+* *+************************************************************************++************************************************************************+* *+* 7. Limitation of Liability *+* -------------------------- *+* *+* Under no circumstances and under no legal theory, whether tort *+* (including negligence), contract, or otherwise, shall any *+* Contributor, or anyone who distributes Covered Software as *+* permitted above, be liable to You for any direct, indirect, *+* special, incidental, or consequential damages of any character *+* including, without limitation, damages for lost profits, loss of *+* goodwill, work stoppage, computer failure or malfunction, or any *+* and all other commercial damages or losses, even if such party *+* shall have been informed of the possibility of such damages. This *+* limitation of liability shall not apply to liability for death or *+* personal injury resulting from such party's negligence to the *+* extent applicable law prohibits such limitation. Some *+* jurisdictions do not allow the exclusion or limitation of *+* incidental or consequential damages, so this exclusion and *+* limitation may not apply to You. *+* *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++ This Source Code Form is subject to the terms of the Mozilla Public+ License, v. 2.0. If a copy of the MPL was not distributed with this+ file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++ This Source Code Form is "Incompatible With Secondary Licenses", as+ defined by the Mozilla Public License, v. 2.0.
+ README.md view
@@ -0,0 +1,120 @@+# extensions++++[](https://github.com/kowainik/extensions/actions)+[](https://hackage.haskell.org/package/extensions)+[](LICENSE)++Library and CLI tool to parse Haskell `{-# LANGUAGE #-}` extensions in+source files, extract `default-extensions` from `.cabal` files and+combine together `default-extensions` and per-module extensions.++## Goals++The `extensions` library provides a lighweight way to get Haskell+LANGUAGE pragmas for Haskell modules. It has the following goals:++1. Be **lightweight**. Dependency footprint is extremely small,+ and using `extensions` either as a library or as a tool is+ straightforward.+2. Support both `default-extensions` in **Cabal** and `{-# LANGUAGE #-}`+ pragmas in **Haskell** modules.+3. Should work on common and real cases. `extensions` strives to+ support as many valid syntactic constructions as possible, but it+ may not work on every possible combination of CPP, comments and+ pragmas, where GHC would work. We encouragle you to+ [open issue](https://github.com/kowainik/extensions/issues/new) if+ you encounter any failures when using `extensions`.++## How to use++You can use `extensions` either as a library or as a CLI tool.++### Library++#### Usage with Cabal++`extensions` is compatible with the latest GHC compiler+versions starting from `8.8.3`.++In order to start using `extensions` in your project, you+will need to set it up with the three easy steps:++1. Add the dependency on `extensions` in your project's+ `.cabal` file. For this, you should modify the `build-depends`+ section by adding the name of this library. After the adjustment,+ this section could look like this:++ ```haskell+ build-depends: base ^>= 4.14+ , extensions ^>= 0.0+ ```+2. In the module where you wish to extract extensions, you+ should add the import:++ ```haskell+ import Extensions (getPackageExtensions)+ ```+3. Now you can use the types and functions from the library:++ ```haskell+ main :: IO ()+ main = getPackageExtensions "extensions.cabal" >>= print+ ```++#### Usage with Stack++If `extensions` is not available on your current Stackage+resolver yet, fear not! You can still use it from Hackage by adding+the following to the `extra-deps` section of your `stack.yaml` file:++```yaml+extra-deps:+ - extensions-0.0.0.0+```++### CLI tool++To use `extensions` as a CLI tool, you need to install it either with Cabal++```+cabal install extensions+```++or Stack++```+stack install extensions+```++The tool can be used to inspect language extensions in your Haskell+project. Some common usages of the tool:++1. Get all extensions in all modules, combined with+ `default-extensions` from the `.cabal` file.+ +2. Get all extensions for a specific module, combined with Cabal+ extensions.+ +3. Get extensions defined only in a module.+ ++## Alternatives++Alternatively, you can extract Haskell Language extensions using the+following ways:++1. Using `ghc` as a library. This approach ties you to a specific GHC+ version and requires more effort to support multiple GHCs. Also,+ GHC API is more complicated than `extensions` API (especially if+ you want to handle `CPP`). And even with `CPP` handling from `ghc`+ you won't be able to get all extensions defined in a+ module. However, this approach allows you to fully reproduce GHC+ behaviour.+2. Using `ghc-lib-parser`. Same as the previous approach, but does not+ tie you to a specific GHC version. However, `ghc-lib-parser` is+ rather big dependency.+3. Using the `haskell-src-exts` library. This library parses Haskell+ source files, but it's not actively maintained anymore and doesn't+ support `CPP`.
+ app/Cli.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE ApplicativeDo #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++CLI options for the @extensions@ exectuable.+-}++module Cli+ ( ExtensionsArgs (..)+ , Toggle (..)+ , runExtensionsCli+ ) where++import Options.Applicative (Parser, ParserInfo, execParser, flag, fullDesc, help, helper, info,+ long, metavar, optional, progDesc, strOption)+++-- | Options used for the main @extensions@ executable.+data ExtensionsArgs = ExtensionsArgs+ { -- | Path to cabal file+ extensionsArgsCabalFilePath :: !(Maybe FilePath)+ -- | Path to module+ , extensionsArgsModuleFilePath :: !(Maybe FilePath)+ -- | When 'Disabled', do not check extensions in @.cabal@ file+ , extensionsArgsCabalToggle :: !Toggle+ -- | When 'Disabled', print only @.cabal@ file's @default-extensions@+ , extensionsArgsModulesToggle :: !Toggle+ }++data Toggle+ = Disabled+ | Enabled++-- | Run main parser of the @extensions@ command line tool.+runExtensionsCli :: IO ExtensionsArgs+runExtensionsCli = execParser extensionsCliParser++extensionsCliParser :: ParserInfo ExtensionsArgs+extensionsCliParser = info (helper <*> extensionsP) $+ fullDesc <> progDesc "Display Haskell Language Extensions"++-- | @extensions@ command parser.+extensionsP :: Parser ExtensionsArgs+extensionsP = do+ extensionsArgsCabalFilePath <- filePathP "cabal" ".cabal file"+ extensionsArgsModuleFilePath <- filePathP "module" "Haskell module"+ extensionsArgsCabalToggle <- noCabalP+ extensionsArgsModulesToggle <- noModulesP+ pure ExtensionsArgs{..}++filePathP :: String -> String -> Parser (Maybe FilePath)+filePathP opt desc = optional $ strOption $ mconcat+ [ long $ opt <> "-file-path"+ , metavar "FILE_PATH"+ , help $ "Relative path to the " <> desc+ ]++noCabalP :: Parser Toggle+noCabalP = flag Enabled Disabled $ mconcat+ [ long "no-cabal"+ , help "Do not check extensions in the .cabal file"+ ]++noModulesP :: Parser Toggle+noModulesP = flag Enabled Disabled $ mconcat+ [ long "no-modules"+ , help "Print only .cabal file's 'default-extensions'"+ ]
+ app/Main.hs view
@@ -0,0 +1,168 @@+module Main (main) where++import Colourista (errorMessage, infoMessage)+import Control.Exception (catch)+import Data.Foldable (forM_, for_)+import Data.List (nub)+import Data.Text (Text)+import GHC.Exts (sortWith)+import System.Directory (doesFileExist, getCurrentDirectory, listDirectory)+import System.Exit (exitFailure)+import System.FilePath (takeExtension, (</>))++import Cli (ExtensionsArgs (..), Toggle (..), runExtensionsCli)+import Extensions (ExtensionsResult, getModuleExtentions, getPackageExtentions)+import Extensions.Cabal (parseCabalFileExtensions)+import Extensions.Module (parseFile)+import Extensions.Types (CabalException, Extensions (..), OnOffExtension (..),+ ParsedExtensions (..), SafeHaskellExtension, showOnOffExtension)++import qualified Data.Map as Map+import qualified Data.Text as Text+import qualified Data.Text.IO as TextIO+++main :: IO ()+main = do+ ExtensionsArgs{..} <- runExtensionsCli+ run extensionsArgsCabalFilePath+ extensionsArgsModuleFilePath+ extensionsArgsCabalToggle+ extensionsArgsModulesToggle+++run :: Maybe FilePath -> Maybe FilePath -> Toggle -> Toggle -> IO ()+run mCabalPath mModulePath cabal modules = case (mCabalPath, mModulePath, cabal, modules) of+ -- no options specified+ (Nothing, Nothing, Enabled, Enabled) ->+ findCabalFile >>= printAllModulesExtensions++ -- --no-modules+ (Nothing, Nothing, Enabled, Disabled) ->+ findCabalFile >>= printOnlyCabalExtensions++ -- --no-cabal+ (Nothing, Nothing, Disabled, _modules) -> exitAfter $ do+ errorMessage "No cabal file or module specified"+ infoMessage "Use the --module-file-path option to print extensions for a module"++ -- --cabal-file-path+ (Just cabalPath, Nothing, Enabled, Enabled) ->+ withPath cabalPath (printAllModulesExtensions cabalPath)++ -- --cabal-file-path --no-modules+ (Just cabalPath, Nothing, Enabled, Disabled) ->+ withPath cabalPath (printOnlyCabalExtensions cabalPath)++ -- --cabal-file-path --no-cabal+ (Just _cabalPath, _modulePath, Disabled, _modules) -> exitAfter $+ errorMessage "Both --cabal-file-path and --no-cabal are specified"++ -- --module-file-path --no-modules+ (_cabalPath, Just _modulePath, _cabal, Disabled) -> exitAfter $+ errorMessage "Both --module-file-path and --no-modules are specified"++ -- --module-file-path+ (Nothing, Just modulePath, Enabled, Enabled) -> withPath modulePath $ do+ cabalPath <- findCabalFile+ extsResult <- getModuleExtentions cabalPath modulePath+ infoMessage $ "Cabal extensions and extensions in module " <> Text.pack modulePath+ printExtensionsResult extsResult++ -- --module-file-path --no-cabal+ (Nothing, Just modulePath, Disabled, Enabled) -> withPath modulePath $+ parseFile modulePath >>= \case+ Left err ->+ errorMessage $ "Error parsing module: " <> tshow err+ Right ParsedExtensions{..} -> do+ infoMessage $ "Extensions defined only in " <> Text.pack modulePath+ printOnOffExtensions parsedExtensionsAll+ case parsedExtensionsSafe of+ Just safe -> print safe+ Nothing -> pure ()++ -- --cabal-file-path --module-file-path+ (Just cabalPath, Just modulePath, Enabled, Enabled) ->+ withPath cabalPath $ withPath modulePath $ do+ extsResult <- getModuleExtentions cabalPath modulePath+ infoMessage $ "Cabal extensions and extensions in module " <> Text.pack modulePath+ printExtensionsResult extsResult+ where+ -- check whether the file exist under the path and run action only if exists+ withPath :: FilePath -> IO a -> IO a+ withPath path action = doesFileExist path >>= \pathExists ->+ if pathExists+ then action+ else exitAfter $ errorMessage $ "File does not exist: " <> Text.pack path++exitAfter :: IO a -> IO b+exitAfter action = action >> exitFailure++-- | Find a @.cabal@ file in the current directory.+findCabalFile :: IO FilePath+findCabalFile = do+ dirPath <- getCurrentDirectory+ dirContent <- listDirectory dirPath+ let cabalFiles = filter (\p -> takeExtension p == ".cabal") dirContent+ let usageHint = infoMessage+ "Use the --cabal-file-path option to specify path to .cabal file"+ case cabalFiles of+ [] -> exitAfter $ do+ errorMessage ".cabal file not found in the current directory"+ usageHint+ [cabalFile] ->+ pure $ dirPath </> cabalFile+ l -> exitAfter $ do+ errorMessage $ "Multiple .cabal files found: "+ <> Text.intercalate ", " (map Text.pack l)+ usageHint++printAllModulesExtensions :: FilePath -> IO ()+printAllModulesExtensions cabalPath = do+ cabalExts <- handleCabalException $ getPackageExtentions cabalPath+ infoMessage "Extensions for each module combined with 'default-extensions'"++ let modules = sortWith fst $ Map.toList cabalExts+ forM_ modules $ \(path, extsRes) -> do+ putStrLn path+ case extsRes of+ Left err -> errorMessage $ " Error: " <> tshow err+ Right Extensions{..} -> do+ mapM_ (TextIO.putStrLn . (" " <>) . showOnOffExtension) extensionsAll+ case extensionsSafe of+ Just safe -> putStrLn $ " " <> show safe+ Nothing -> pure ()++printOnlyCabalExtensions :: FilePath -> IO ()+printOnlyCabalExtensions cabalPath = do+ cabalExts <- handleCabalException $ parseCabalFileExtensions cabalPath+ let (g, x) = concatAll $ Map.elems cabalExts+ let (exts, mSafe) = ( nub g , nub x)++ infoMessage $ "All language extensions defined in " <> Text.pack cabalPath+ printOnOffExtensions exts+ for_ mSafe $ \case+ Just safe -> print safe+ Nothing -> pure ()+ where+ concatAll :: [ParsedExtensions] -> ([OnOffExtension], [Maybe SafeHaskellExtension])+ concatAll = foldMap (\ParsedExtensions{..} -> (parsedExtensionsAll, [parsedExtensionsSafe]))++handleCabalException :: IO a -> IO a+handleCabalException action = action `catch` \(exc :: CabalException) -> exitAfter $+ errorMessage $ "Error processing .cabal file: " <> tshow exc++printOnOffExtensions :: Foldable f => f OnOffExtension -> IO ()+printOnOffExtensions = mapM_ (TextIO.putStrLn . showOnOffExtension)++printExtensionsResult :: ExtensionsResult -> IO ()+printExtensionsResult = \case+ Left err -> errorMessage $ "Error in finding extensions: " <> tshow err+ Right Extensions{..} -> do+ printOnOffExtensions extensionsAll+ case extensionsSafe of+ Just safe -> print safe+ Nothing -> pure ()++tshow :: Show a => a -> Text+tshow = Text.pack . show
+ extensions.cabal view
@@ -0,0 +1,112 @@+cabal-version: 2.4+name: extensions+version: 0.0.0.0+synopsis: Parse Haskell Language Extensions+description: Parse Haskell Language Extensions.+ See [README.md](https://github.com/kowainik/extensions#extensions) for more details.+homepage: https://github.com/kowainik/extensions+bug-reports: https://github.com/kowainik/extensions/issues+license: MPL-2.0+license-file: LICENSE+author: Veronika Romashkina, Dmitrii Kovanikov+maintainer: Kowainik <xrom.xkov@gmail.com>+copyright: 2020 Kowainik+category: GHC, Parsing, Haskell+build-type: Simple+extra-doc-files: README.md+ CHANGELOG.md+tested-with: GHC == 8.8.3+ GHC == 8.10.1++source-repository head+ type: git+ location: https://github.com/kowainik/extensions.git++common common-options+ build-depends: base >= 4.13.0.0 && < 4.15++ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ if impl(ghc >= 8.0)+ ghc-options: -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.8)+ ghc-options: -Wmissing-deriving-strategies+ if impl(ghc >= 8.10.1)+ ghc-options: -Wunused-packages++ default-language: Haskell2010+ default-extensions: ConstraintKinds+ DeriveGeneric+ DerivingStrategies+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ OverloadedStrings+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TupleSections+ TypeApplications+ ViewPatterns++library+ import: common-options+ hs-source-dirs: src+ exposed-modules: Extensions+ Extensions.Cabal+ Extensions.Module+ Extensions.Package+ Extensions.Types++ build-depends: bytestring ^>= 0.10+ , Cabal >= 3.0 && < 3.3+ , containers ^>= 0.6+ , directory ^>= 1.3+ , filepath ^>= 1.4+ , ghc-boot-th >= 8.8.1 && < 8.11+ , parsec ^>= 3.1+ , text ^>= 1.2.3++executable extensions+ import: common-options+ hs-source-dirs: app+ main-is: Main.hs+ other-modules: Cli+ build-depends: extensions+ , base+ , colourista ^>= 0.1.0.0+ , containers+ , directory+ , filepath+ , optparse-applicative ^>= 0.15+ , text++test-suite extensions-test+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Test.Extensions+ Test.Extensions.Cabal+ Test.Extensions.Module+ Test.Extensions.Types+ build-depends: extensions+ , bytestring+ , containers+ , ghc-boot-th+ , hedgehog ^>= 1.0+ , hspec+ , hspec-hedgehog ^>= 0.0.1+ , text ^>= 1.2+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N
+ src/Extensions.hs view
@@ -0,0 +1,63 @@+{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Library to get Haskell Language Extensions from @.cabal@ files, Haskell Modules,+or get combined information from both sources preserving correct merge logic of+extensions.+-}++module Extensions+ ( -- $types+ module Extensions.Types+ -- $package+ , module Extensions.Package+ -- $cabal+ , module Extensions.Cabal+ -- $module+ , module Extensions.Module+ ) where++import Extensions.Cabal+import Extensions.Module+import Extensions.Package+import Extensions.Types++{- $types+Main data types to work with any kind of extensions and all possible errors+during the work of @extensions@ functions.++To read more on Haskell Extensions, see the following documentation page:++ * [GHC Language Extensions](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html)++In @extensions@ we support both @Haskell2010@ and @SafeHaskell@+extensions.+-}++{- $package+Main functions to get information of used extensions by combined information+from @.cabal@ files and Haskell modules. This module includes functions that+could work with file paths or file sources, these functions kindly combine+extensions information in a convenient way. However, there are functions that+return Cabal and Module information separately for specified modules.++These functions use provided by "Extensions.Cabal" and "Extensions.Module"+functions to achieve that.+-}++{- $cabal+Functions to extract extensions from the @.cabal@ files.++Also, this module provides convenient functions for conversion of Cabal and GHC+extensions types.++-}++{- $module+Functions to extract extensions from the Haskell modules.++Also, this module exports convenient internal parsing functions for Haskell+module extensions and necessary statements.+-}
+ src/Extensions/Cabal.hs view
@@ -0,0 +1,360 @@+{-# LANGUAGE CPP #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Functions to extract extensions from the @.cabal@ files.+-}++module Extensions.Cabal+ ( parseCabalFileExtensions+ , parseCabalExtensions+ , extractCabalExtensions++ -- * Bridge between Cabal and GHC extensions+ , cabalToGhcExtension+ , toGhcExtension+ , toSafeExtensions+ ) where++import Control.Exception (throwIO)+import Data.ByteString (ByteString)+import Data.Either (partitionEithers)+import Data.Foldable (toList)+import Data.List (nub)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict (Map)+import Data.Maybe (catMaybes, mapMaybe)+import Data.Text (Text)+import Distribution.ModuleName (ModuleName (..), toFilePath)+import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult)+import Distribution.Parsec.Error (PError, showPError)+import Distribution.Types.Benchmark (Benchmark (..))+import Distribution.Types.BenchmarkInterface (BenchmarkInterface (..))+import Distribution.Types.BuildInfo (BuildInfo (..))+import Distribution.Types.CondTree (CondTree (..))+import Distribution.Types.Executable (Executable (..))+import Distribution.Types.ForeignLib (ForeignLib (..))+import Distribution.Types.GenericPackageDescription (GenericPackageDescription (..))+import Distribution.Types.Library (Library (..))+import Distribution.Types.TestSuite (TestSuite (..))+import Distribution.Types.TestSuiteInterface (TestSuiteInterface (..))+import GHC.LanguageExtensions.Type (Extension (..))+import System.Directory (doesFileExist)+import System.FilePath ((<.>), (</>))++import Extensions.Types (CabalException (..), OnOffExtension (..), ParsedExtensions (..),+ SafeHaskellExtension (..))++import qualified Data.ByteString as ByteString+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import qualified Language.Haskell.Extension as Cabal+++{- | Parse default extensions from a @.cabal@ file under given+'FilePath'.++__Throws__:++* 'CabalException'+-}+parseCabalFileExtensions :: FilePath -> IO (Map FilePath ParsedExtensions)+parseCabalFileExtensions cabalPath = doesFileExist cabalPath >>= \hasCabalFile ->+ if hasCabalFile+ then ByteString.readFile cabalPath >>= parseCabalExtensions cabalPath+ else throwIO $ CabalFileNotFound cabalPath++{- | Parse default extensions from a @.cabal@ file content. This+function takes a path to a @.cabal@ file. The path is only used for error+message. Pass empty string, if you don't have a path to @.cabal@ file.++__Throws__:++* 'CabalException'+-}+parseCabalExtensions :: FilePath -> ByteString -> IO (Map FilePath ParsedExtensions)+parseCabalExtensions path cabal = do+ let (_warnings, res) = runParseResult $ parseGenericPackageDescription cabal+ case res of+ Left (_version, errors) ->+ throwIO $ CabalParseError $ prettyCabalErrors errors+ Right pkgDesc -> extractCabalExtensions pkgDesc+ where+ prettyCabalErrors :: Foldable f => f PError -> Text+ prettyCabalErrors = Text.intercalate "\n" . map errorToText . toList++ errorToText :: PError -> Text+ errorToText = Text.pack . showPError path++{- | Extract Haskell Language extensions from a Cabal package+description.+-}+extractCabalExtensions :: GenericPackageDescription -> IO (Map FilePath ParsedExtensions)+extractCabalExtensions GenericPackageDescription{..} = mconcat+ [ foldMap libraryToExtensions condLibrary+ , foldSndMap libraryToExtensions condSubLibraries+ , foldSndMap foreignToExtensions condForeignLibs+ , foldSndMap exeToExtensions condExecutables+ , foldSndMap testToExtensions condTestSuites+ , foldSndMap benchToExtensions condBenchmarks+ ]+ where+ foldSndMap :: Monoid m => (a -> m) -> [(b, a)] -> m+ foldSndMap f = foldMap (f . snd)++ libraryToExtensions :: CondTree var deps Library -> IO (Map FilePath ParsedExtensions)+ libraryToExtensions = condTreeToExtensions+ (map toModulePath . exposedModules)+ libBuildInfo++ foreignToExtensions :: CondTree var deps ForeignLib -> IO (Map FilePath ParsedExtensions)+ foreignToExtensions = condTreeToExtensions (const []) foreignLibBuildInfo++ exeToExtensions :: CondTree var deps Executable -> IO (Map FilePath ParsedExtensions)+ exeToExtensions = condTreeToExtensions (\Executable{..} -> [modulePath]) buildInfo++ testToExtensions :: CondTree var deps TestSuite -> IO (Map FilePath ParsedExtensions)+ testToExtensions = condTreeToExtensions testMainPath testBuildInfo+ where+ testMainPath :: TestSuite -> [FilePath]+ testMainPath TestSuite{..} = case testInterface of+ TestSuiteExeV10 _ path -> [path]+ TestSuiteLibV09 _ m -> [toModulePath m]+ TestSuiteUnsupported _ -> []++ benchToExtensions :: CondTree var deps Benchmark -> IO (Map FilePath ParsedExtensions)+ benchToExtensions = condTreeToExtensions benchMainPath benchmarkBuildInfo+ where+ benchMainPath :: Benchmark -> [FilePath]+ benchMainPath Benchmark{..} = case benchmarkInterface of+ BenchmarkExeV10 _ path -> [path]+ BenchmarkUnsupported _ -> []++condTreeToExtensions+ :: (comp -> [FilePath])+ -- ^ Get all modules as file paths from a component, not listed in 'BuildInfo'+ -> (comp -> BuildInfo)+ -- ^ Extract 'BuildInfo' from component+ -> CondTree var deps comp+ -- ^ Cabal stanza+ -> IO (Map FilePath ParsedExtensions)+condTreeToExtensions extractModules extractBuildInfo condTree = do+ let comp = condTreeData condTree+ let buildInfo = extractBuildInfo comp+ let srcDirs = hsSourceDirs buildInfo+ let modules = extractModules comp +++ map toModulePath (otherModules buildInfo ++ autogenModules buildInfo)+ let (safeExts, parsedExtensionsAll) = partitionEithers $ mapMaybe cabalToGhcExtension $ defaultExtensions buildInfo+ parsedExtensionsSafe <- case nub safeExts of+ [] -> pure Nothing+ [x] -> pure $ Just x+ x:xs -> throwIO $ CabalSafeExtensionsConflict $ x :| xs++ modulesToExtensions ParsedExtensions{..} srcDirs modules++modulesToExtensions+ :: ParsedExtensions+ -- ^ List of default extensions in the stanza+ -> [FilePath]+ -- ^ hs-src-dirs+ -> [FilePath]+ -- ^ All modules in the stanza+ -> IO (Map FilePath ParsedExtensions)+modulesToExtensions extensions srcDirs = case srcDirs of+ [] -> findTopLevel+ _ -> findInDirs []+ where+ mapFromPaths :: [FilePath] -> Map FilePath ParsedExtensions+ mapFromPaths = Map.fromList . map (, extensions)++ findInDirs :: [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)+ findInDirs res [] = pure $ mapFromPaths res+ findInDirs res (m:ms) = findDir m srcDirs >>= \case+ Nothing -> findInDirs res ms+ Just modulePath -> findInDirs (modulePath : res) ms++ findTopLevel :: [FilePath] -> IO (Map FilePath ParsedExtensions)+ findTopLevel modules = do+ mPaths <- traverse (withDir Nothing) modules+ pure $ mapFromPaths $ catMaybes mPaths++ -- Find directory where path exists and return full path+ findDir :: FilePath -> [FilePath] -> IO (Maybe FilePath)+ findDir modulePath = \case+ [] -> pure Nothing+ dir:dirs -> withDir (Just dir) modulePath >>= \case+ Nothing -> findDir modulePath dirs+ Just path -> pure $ Just path++ -- returns path if it exists inside optional dir+ withDir :: Maybe FilePath -> FilePath -> IO (Maybe FilePath)+ withDir mDir path = do+ let fullPath = maybe path (\dir -> dir </> path) mDir+ doesFileExist fullPath >>= \isFile ->+ if isFile+ then pure $ Just fullPath+ else pure Nothing++toModulePath :: ModuleName -> FilePath+toModulePath moduleName = toFilePath moduleName <.> "hs"++-- | Convert 'Cabal.Extension' to 'OnOffExtension' or 'SafeHaskellExtension'.+cabalToGhcExtension :: Cabal.Extension -> Maybe (Either SafeHaskellExtension OnOffExtension)+cabalToGhcExtension = \case+ Cabal.EnableExtension extension -> case (toGhcExtension extension, toSafeExtensions extension) of+ (Nothing, safe) -> Left <$> safe+ (ghc, _) -> Right . On <$> ghc+ Cabal.DisableExtension extension -> Right . Off <$> toGhcExtension extension+ Cabal.UnknownExtension _ -> Nothing++-- | Convert 'Cabal.KnownExtension' to 'OnOffExtension'.+toGhcExtension :: Cabal.KnownExtension -> Maybe Extension+toGhcExtension = \case+ Cabal.OverlappingInstances -> Just OverlappingInstances+ Cabal.UndecidableInstances -> Just UndecidableInstances+ Cabal.IncoherentInstances -> Just IncoherentInstances+ Cabal.DoRec -> Just RecursiveDo+ Cabal.RecursiveDo -> Just RecursiveDo+ Cabal.ParallelListComp -> Just ParallelListComp+ Cabal.MultiParamTypeClasses -> Just MultiParamTypeClasses+ Cabal.MonomorphismRestriction -> Just MonomorphismRestriction+ Cabal.FunctionalDependencies -> Just FunctionalDependencies+ Cabal.Rank2Types -> Just RankNTypes+ Cabal.RankNTypes -> Just RankNTypes+ Cabal.PolymorphicComponents -> Just RankNTypes+ Cabal.ExistentialQuantification -> Just ExistentialQuantification+ Cabal.ScopedTypeVariables -> Just ScopedTypeVariables+ Cabal.PatternSignatures -> Just ScopedTypeVariables+ Cabal.ImplicitParams -> Just ImplicitParams+ Cabal.FlexibleContexts -> Just FlexibleContexts+ Cabal.FlexibleInstances -> Just FlexibleInstances+ Cabal.EmptyDataDecls -> Just EmptyDataDecls+ Cabal.CPP -> Just Cpp+ Cabal.KindSignatures -> Just KindSignatures+ Cabal.BangPatterns -> Just BangPatterns+ Cabal.TypeSynonymInstances -> Just TypeSynonymInstances+ Cabal.TemplateHaskell -> Just TemplateHaskell+ Cabal.ForeignFunctionInterface -> Just ForeignFunctionInterface+ Cabal.Arrows -> Just Arrows+ Cabal.ImplicitPrelude -> Just ImplicitPrelude+ Cabal.PatternGuards -> Just PatternGuards+ Cabal.GeneralizedNewtypeDeriving -> Just GeneralizedNewtypeDeriving+ Cabal.GeneralisedNewtypeDeriving -> Just GeneralizedNewtypeDeriving+ Cabal.MagicHash -> Just MagicHash+ Cabal.TypeFamilies -> Just TypeFamilies+ Cabal.StandaloneDeriving -> Just StandaloneDeriving+ Cabal.UnicodeSyntax -> Just UnicodeSyntax+ Cabal.UnliftedFFITypes -> Just UnliftedFFITypes+ Cabal.InterruptibleFFI -> Just InterruptibleFFI+ Cabal.CApiFFI -> Just CApiFFI+ Cabal.LiberalTypeSynonyms -> Just LiberalTypeSynonyms+ Cabal.TypeOperators -> Just TypeOperators+ Cabal.RecordWildCards -> Just RecordWildCards+ Cabal.RecordPuns -> Just RecordPuns+ Cabal.NamedFieldPuns -> Just RecordPuns+ Cabal.DisambiguateRecordFields -> Just DisambiguateRecordFields+ Cabal.TraditionalRecordSyntax -> Just TraditionalRecordSyntax+ Cabal.OverloadedStrings -> Just OverloadedStrings+ Cabal.GADTs -> Just GADTs+ Cabal.GADTSyntax -> Just GADTSyntax+ Cabal.RelaxedPolyRec -> Just RelaxedPolyRec+ Cabal.ExtendedDefaultRules -> Just ExtendedDefaultRules+ Cabal.UnboxedTuples -> Just UnboxedTuples+ Cabal.DeriveDataTypeable -> Just DeriveDataTypeable+ Cabal.AutoDeriveTypeable -> Just DeriveDataTypeable+ Cabal.DeriveGeneric -> Just DeriveGeneric+ Cabal.DefaultSignatures -> Just DefaultSignatures+ Cabal.InstanceSigs -> Just InstanceSigs+ Cabal.ConstrainedClassMethods -> Just ConstrainedClassMethods+ Cabal.PackageImports -> Just PackageImports+ Cabal.ImpredicativeTypes -> Just ImpredicativeTypes+ Cabal.PostfixOperators -> Just PostfixOperators+ Cabal.QuasiQuotes -> Just QuasiQuotes+ Cabal.TransformListComp -> Just TransformListComp+ Cabal.MonadComprehensions -> Just MonadComprehensions+ Cabal.ViewPatterns -> Just ViewPatterns+ Cabal.TupleSections -> Just TupleSections+ Cabal.GHCForeignImportPrim -> Just GHCForeignImportPrim+ Cabal.NPlusKPatterns -> Just NPlusKPatterns+ Cabal.DoAndIfThenElse -> Just DoAndIfThenElse+ Cabal.MultiWayIf -> Just MultiWayIf+ Cabal.LambdaCase -> Just LambdaCase+ Cabal.RebindableSyntax -> Just RebindableSyntax+ Cabal.ExplicitForAll -> Just ExplicitForAll+ Cabal.DatatypeContexts -> Just DatatypeContexts+ Cabal.MonoLocalBinds -> Just MonoLocalBinds+ Cabal.DeriveFunctor -> Just DeriveFunctor+ Cabal.DeriveTraversable -> Just DeriveTraversable+ Cabal.DeriveFoldable -> Just DeriveFoldable+ Cabal.NondecreasingIndentation -> Just NondecreasingIndentation+ Cabal.ConstraintKinds -> Just ConstraintKinds+ Cabal.PolyKinds -> Just PolyKinds+ Cabal.DataKinds -> Just DataKinds+ Cabal.ParallelArrays -> Just ParallelArrays+ Cabal.RoleAnnotations -> Just RoleAnnotations+ Cabal.OverloadedLists -> Just OverloadedLists+ Cabal.EmptyCase -> Just EmptyCase+ Cabal.NegativeLiterals -> Just NegativeLiterals+ Cabal.BinaryLiterals -> Just BinaryLiterals+ Cabal.NumDecimals -> Just NumDecimals+ Cabal.NullaryTypeClasses -> Just NullaryTypeClasses+ Cabal.ExplicitNamespaces -> Just ExplicitNamespaces+ Cabal.AllowAmbiguousTypes -> Just AllowAmbiguousTypes+ Cabal.JavaScriptFFI -> Just JavaScriptFFI+ Cabal.PatternSynonyms -> Just PatternSynonyms+ Cabal.PartialTypeSignatures -> Just PartialTypeSignatures+ Cabal.NamedWildCards -> Just NamedWildCards+ Cabal.DeriveAnyClass -> Just DeriveAnyClass+ Cabal.DeriveLift -> Just DeriveLift+ Cabal.StaticPointers -> Just StaticPointers+ Cabal.StrictData -> Just StrictData+ Cabal.Strict -> Just Strict+ Cabal.ApplicativeDo -> Just ApplicativeDo+ Cabal.DuplicateRecordFields -> Just DuplicateRecordFields+ Cabal.TypeApplications -> Just TypeApplications+ Cabal.TypeInType -> Just TypeInType+ Cabal.UndecidableSuperClasses -> Just UndecidableSuperClasses+ Cabal.MonadFailDesugaring -> Just MonadFailDesugaring+ Cabal.TemplateHaskellQuotes -> Just TemplateHaskellQuotes+ Cabal.OverloadedLabels -> Just OverloadedLabels+ Cabal.TypeFamilyDependencies -> Just TypeFamilyDependencies+ Cabal.DerivingStrategies -> Just DerivingStrategies+ Cabal.DerivingVia -> Just DerivingVia+ Cabal.UnboxedSums -> Just UnboxedSums+ Cabal.HexFloatLiterals -> Just HexFloatLiterals+ Cabal.BlockArguments -> Just BlockArguments+ Cabal.NumericUnderscores -> Just NumericUnderscores+ Cabal.QuantifiedConstraints -> Just QuantifiedConstraints+ Cabal.StarIsType -> Just StarIsType+ Cabal.EmptyDataDeriving -> Just EmptyDataDeriving+#if __GLASGOW_HASKELL__ >= 810+ Cabal.CUSKs -> Just CUSKs+ Cabal.ImportQualifiedPost -> Just ImportQualifiedPost+ Cabal.StandaloneKindSignatures -> Just StandaloneKindSignatures+ Cabal.UnliftedNewtypes -> Just UnliftedNewtypes+#endif+ -- GHC extensions, parsed by both Cabal and GHC, but don't have an Extension constructor+ Cabal.Safe -> Nothing+ Cabal.Trustworthy -> Nothing+ Cabal.Unsafe -> Nothing+ -- non-GHC extensions+ Cabal.Generics -> Nothing+ Cabal.ExtensibleRecords -> Nothing+ Cabal.RestrictedTypeSynonyms -> Nothing+ Cabal.HereDocuments -> Nothing+ Cabal.MonoPatBinds -> Nothing+ Cabal.XmlSyntax -> Nothing+ Cabal.RegularPatterns -> Nothing+ Cabal.SafeImports -> Nothing+ Cabal.NewQualifiedOperators -> Nothing++-- | Convert 'Cabal.KnownExtension' to 'SafeHaskellExtension'.+toSafeExtensions :: Cabal.KnownExtension -> Maybe SafeHaskellExtension+toSafeExtensions = \case+ Cabal.Safe -> Just Safe+ Cabal.Trustworthy -> Just Trustworthy+ Cabal.Unsafe -> Just Unsafe+ _ -> Nothing
+ src/Extensions/Module.hs view
@@ -0,0 +1,214 @@+{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Parser for Haskell Modules to get all Haskell Language Extensions used.+-}++module Extensions.Module+ ( parseFile+ , parseSource+ , parseSourceWithPath++ -- * Internal Parsers+ , extensionsP+ , singleExtensionsP+ , extensionP+ , languagePragmaP+ , optionsGhcP+ , pragmaP+ , commentP+ , cppP+ ) where++import Data.ByteString (ByteString)+import Data.Char (toLower, toUpper)+import Data.Either (partitionEithers)+import Data.Foldable (traverse_)+import Data.Functor ((<&>))+import Data.List (nub)+import Data.List.NonEmpty (NonEmpty (..))+import System.Directory (doesFileExist)+import Text.Parsec (alphaNum, between, char, eof, many, many1, manyTill, noneOf, oneOf, parse,+ sepBy1, try, (<|>))+import Text.Parsec.ByteString (Parser)+import Text.Parsec.Char (anyChar, endOfLine, letter, newline, space, spaces, string)+import Text.Read (readMaybe)++import Extensions.Types (ModuleParseError (..), OnOffExtension (..), ParsedExtensions (..),+ SafeHaskellExtension (..), readOnOffExtension)++import qualified Data.ByteString as BS+++-- | Internal data type for known and unknown extensions.+data ParsedExtension+ = KnownExtension OnOffExtension+ | SafeExtension SafeHaskellExtension+ | UnknownExtension String++handleParsedExtensions :: [ParsedExtension] -> Either ModuleParseError ParsedExtensions+handleParsedExtensions = handleResult . partitionEithers . map toEither+ where+ toEither :: ParsedExtension -> Either String (Either SafeHaskellExtension OnOffExtension)+ toEither (UnknownExtension ext) = Left ext+ toEither (KnownExtension ext) = Right $ Right ext+ toEither (SafeExtension ext) = Right $ Left ext++ -- Make sure that there is no conflicting 'SafeHaskellExtension's.+ handleResult+ :: ([String], [Either SafeHaskellExtension OnOffExtension])+ -> Either ModuleParseError ParsedExtensions+ handleResult (unknown, knownAndSafe) = case unknown of+ [] -> let (safe, known) = partitionEithers knownAndSafe in case nub safe of+ [] -> Right ParsedExtensions+ { parsedExtensionsAll = known+ , parsedExtensionsSafe = Nothing+ }+ [s] -> Right ParsedExtensions+ { parsedExtensionsAll = known+ , parsedExtensionsSafe = Just s+ }+ s:ss -> Left $ ModuleSafeHaskellConflict $ s :| ss+ x:xs -> Left $ UnknownExtensions $ x :| xs++{- | By the given file path, reads the file and returns 'ParsedExtensions', if+parsing succeeds.+-}+parseFile :: FilePath -> IO (Either ModuleParseError ParsedExtensions)+parseFile file = doesFileExist file >>= \hasFile ->+ if hasFile+ then parseSourceWithPath file <$> BS.readFile file+ else pure $ Left $ FileNotFound file++{- | By the given file path and file source content, returns 'ParsedExtensions',+if parsing succeeds.++This function takes a path to a Haskell source file. The path is only used for+error message. Pass empty string or use 'parseSource', if you don't have a path+to a Haskell module.+-}+parseSourceWithPath :: FilePath -> ByteString -> Either ModuleParseError ParsedExtensions+parseSourceWithPath path src = case parse extensionsP path src of+ Left err -> Left $ ParsecError err+ Right parsedExts -> handleParsedExtensions parsedExts++{- | By the given file source content, returns 'ParsedExtensions', if parsing+succeeds.+-}+parseSource :: ByteString -> Either ModuleParseError ParsedExtensions+parseSource = parseSourceWithPath "SourceName"++{- | The main parser of 'ParsedExtension'.++It parses language pragmas or comments until end of file or the first line with+the function/import/module name.+-}+extensionsP :: Parser [ParsedExtension]+extensionsP = concat <$> manyTill+ (try singleExtensionsP <|> try optionsGhcP <|> try commentP <|> try cppP)+ (eof <|> (() <$ manyTill endOfLine letter))++{- | Single LANGUAGE pragma parser.++@+ \{\-# LANGUAGE XXX+ , YYY ,+ ZZZ+ #\-\}+@+-}+singleExtensionsP :: Parser [ParsedExtension]+singleExtensionsP =+ languagePragmaP (commaSep (nonExtP *> extensionP <* nonExtP) <* spaces)+ where+ nonExtP :: Parser ()+ nonExtP = () <$ many (try cppP <|> try commentP)++{- | Parses all known and unknown 'OnOffExtension's or 'SafeHaskellExtension's.+-}+extensionP :: Parser ParsedExtension+extensionP = (spaces *> many1 alphaNum <* spaces) <&> \txt ->+ case readOnOffExtension txt of+ Just ext -> KnownExtension ext+ Nothing -> case readMaybe @SafeHaskellExtension txt of+ Just ext -> SafeExtension ext+ Nothing -> UnknownExtension txt++{- | Parser for standard language pragma keywords: @\{\-\# LANGUAGE XXX \#\-\}@+-}+languagePragmaP :: Parser a -> Parser a+languagePragmaP = pragmaP $ istringP "LANGUAGE"++{- | Parser for GHC options pragma keywords: @\{\-\# OPTIONS_GHC YYY \#\-\}@+-}+optionsGhcP :: Parser [a]+optionsGhcP = [] <$ optionsGhcPragmaP (many1 ghcOptionP)+ where+ ghcOptionP :: Parser String+ ghcOptionP = newLines *> many1 (alphaNum <|> char '-') <* newLines++optionsGhcPragmaP :: Parser a -> Parser a+optionsGhcPragmaP = pragmaP $ istringP "OPTIONS_GHC"++-- | Parser for case-insensitive strings.+istringP :: String -> Parser ()+istringP = traverse_ $ \c -> oneOf [toUpper c, toLower c]++{- | Parser for GHC pragmas with a given pragma word.+-}+pragmaP :: Parser () -> Parser a -> Parser a+pragmaP pragmaNameP p = between+ (string "{-#") (string "#-}" <* newLines)+ (newLines *> pragmaNameP *> newLines *> p <* newLines)++-- | Comma separated parser. Newlines and spaces are allowed around comma.+commaSep :: Parser a -> Parser [a]+commaSep p = p `sepBy1` (try $ newLines *> char ',' <* newLines)++{- | Haskell comment parser.+Supports both single-line comments:++ @+ -- I am a single comment+ @++and multi-line comments:++ @+ \{\- I+ AM+ MULTILINE+ \-\}+ @+-}+commentP :: Parser [a]+commentP = newLines *> (try singleLineCommentP <|> try multiLineCommentP) <* newLines+ where+ singleLineCommentP :: Parser [a]+ singleLineCommentP = [] <$+ (string "--" *> manyTill anyChar (try (() <$ endOfLine) <|> eof))++ multiLineCommentP :: Parser [a]+ multiLineCommentP = [] <$+ (string "{-" *> manyTill anyChar (try $ string "-}"))++{- | CPP syntax parser.++ @+ #if \_\_GLASGOW_HASKELL\_\_ < 810+ -- Could be more Language pragmas that should be parsed+ #endif+ @+-}+cppP :: Parser [a]+cppP =+ [] <$ many newline+ <* try (char '#' <* noneOf "-")+ <* manyTill anyChar (try endOfLine)+ <* newLines++-- | Any combination of spaces and newlines.+newLines :: Parser ()+newLines = () <$ many (space <|> endOfLine)
+ src/Extensions/Package.hs view
@@ -0,0 +1,189 @@+{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Parse Haskell Language Extensions.+-}++module Extensions.Package+ ( -- * Package modules+ getPackageExtentions+ , getPackageExtentionsBySources++ -- * Single module+ , getModuleAndCabalExtentions+ , getModuleExtentions+ , getModuleAndCabalExtentionsBySource+ , getModuleExtentionsBySource+ ) where++import Control.Exception (catch)+import Data.ByteString (ByteString)+import Data.Functor ((<&>))+import Data.Map.Merge.Strict (mapMissing, merge, zipWithMatched)+import Data.Map.Strict (Map)++import Extensions.Cabal (parseCabalFileExtensions)+import Extensions.Module (parseFile, parseSourceWithPath)+import Extensions.Types (CabalAndModuleExtensions (..), CabalException, ExtensionsError (..),+ ExtensionsResult, ModuleParseError, ParsedExtensions (..),+ mergeAnyExtensions)++import qualified Data.Map.Strict as Map+++{- | By given path to @.cabal@ file, analyse extensions for each Haskell module+and return the corresponding 'Map' with 'ExtensionsResult's.++__Throws__:++* 'CabalException'+-}+getPackageExtentions+ :: FilePath -- ^ Path to @.cabal@ file.+ -> IO (Map FilePath ExtensionsResult)+getPackageExtentions cabalFile = do+ cabalMap <- parseCabalFileExtensions cabalFile+ Map.traverseWithKey perModuleParseMerge cabalMap+ where+ perModuleParseMerge :: FilePath -> ParsedExtensions -> IO ExtensionsResult+ perModuleParseMerge path cabalExts = do+ moduleRes <- parseFile path+ pure $ mergeCabalAndModule cabalExts path moduleRes++{- | By given path to @.cabal@ file and 'Map' of sources of all Haskell+modules, analyse extensions for each Haskell module and return the corresponding+'Map' with 'ExtensionsResult's.+-}+getPackageExtentionsBySources+ :: FilePath -- ^ Path to @.cabal@ file.+ -> Map FilePath ByteString -- ^ Path to modules with corresponding sources.+ -> IO (Map FilePath ExtensionsResult)+getPackageExtentionsBySources cabalFile sourcesMap =+ parseCabalHandleException cabalFile <&> \case+ Left err -> Left err <$ sourcesMap+ Right cabalMap -> merge+ (mapMissing cabalNotSource) -- in cabal but not in sources+ (mapMissing sourceNotCabal) -- in sources but not in cabal+ (zipWithMatched cabalAndSource) -- in cabal and sources+ cabalMap+ sourcesMap+ where+ cabalNotSource :: FilePath -> ParsedExtensions -> ExtensionsResult+ cabalNotSource path _cabalExts = Left $ SourceNotFound path++ sourceNotCabal :: FilePath -> ByteString -> ExtensionsResult+ sourceNotCabal path _source = Left $ NotCabalModule path++ cabalAndSource+ :: FilePath+ -> ParsedExtensions+ -> ByteString+ -> ExtensionsResult+ cabalAndSource path cabalExts source =+ mergeCabalAndModule cabalExts path $ parseSourceWithPath path source++{- | By given path to @.cabal@ file and path to Haskell module of the+corresponding package, analyse and return extensions for the+given module separately from .cabal file and from the module itself.+-}+getModuleAndCabalExtentions+ :: FilePath -- ^ Path to @.cabal@ file.+ -> FilePath -- ^ Path to Haskell module file.+ -> IO (Either ExtensionsError CabalAndModuleExtensions)+getModuleAndCabalExtentions cabalFile path =+ parseCabalHandleException cabalFile >>= \case+ Left err -> pure $ Left err+ Right cabalMap -> case Map.lookup path cabalMap of+ Nothing -> pure $ Left $ NotCabalModule path+ Just cabalExts -> getCabalAndModuleExts path cabalExts <$> parseFile path++{- | By given path to @.cabal@ file and path to Haskell module of the+corresponding package, analyse and return summary set of extensions for the+given module.+-}+getModuleExtentions+ :: FilePath -- ^ Path to @.cabal@ file.+ -> FilePath -- ^ Path to Haskell module file.+ -> IO ExtensionsResult+getModuleExtentions cabalFile path =+ parseCabalHandleException cabalFile >>= \case+ Left err -> pure $ Left err+ Right cabalMap -> case Map.lookup path cabalMap of+ Nothing -> pure $ Left $ NotCabalModule path+ Just cabalExts -> do+ moduleRes <- parseFile path+ pure $ mergeCabalAndModule cabalExts path moduleRes++{- | By given path to @.cabal@ file and path to Haskell module of the+corresponding package, analyse and return extensions extensions for the+given module separately from .cabal file and from the module itself.+-}+getModuleAndCabalExtentionsBySource+ :: FilePath -- ^ Maybe path to @.cabal@ file.+ -> FilePath -- ^ Path to the module's source (needed for matching with cabal file).+ -> ByteString -- ^ Source of a Haskell module file.+ -> IO (Either ExtensionsError CabalAndModuleExtensions)+getModuleAndCabalExtentionsBySource cabalFile path source =+ parseCabalHandleException cabalFile <&> \case+ Left cabalError -> Left cabalError+ Right cabalMap -> case Map.lookup path cabalMap of+ Nothing -> Left $ NotCabalModule path+ Just cabalExts -> getCabalAndModuleExts path cabalExts+ (parseSourceWithPath path source)++{- | By given path to @.cabal@ file and path to Haskell module of the+corresponding package, analyse and return combined set of extensions for the+given module.+-}+getModuleExtentionsBySource+ :: FilePath -- ^ Maybe path to @.cabal@ file.+ -> FilePath -- ^ Path to the module's source (needed for matching with cabal file).+ -> ByteString -- ^ Source of a Haskell module file.+ -> IO ExtensionsResult+getModuleExtentionsBySource cabalFile path source =+ parseCabalHandleException cabalFile <&> \case+ Left cabalError -> Left cabalError+ Right cabalMap -> case Map.lookup path cabalMap of+ Nothing -> Left $ NotCabalModule path+ Just cabalExts -> mergeCabalAndModule cabalExts path+ (parseSourceWithPath path source)++----------------------------------------------------------------------------+-- Internal helpers+----------------------------------------------------------------------------++mergeCabalAndModule+ :: ParsedExtensions+ -> FilePath+ -> Either ModuleParseError ParsedExtensions+ -> ExtensionsResult+mergeCabalAndModule cabalExts path moduleRes = case moduleRes of+ Right moduleExts -> mergeAnyExtensions cabalExts moduleExts+ Left parseErr -> Left $ ModuleParseError path parseErr++-- | 'parseCabalFileExtensions' with 'handleCabalException'.+parseCabalHandleException+ :: FilePath+ -> IO (Either ExtensionsError (Map FilePath ParsedExtensions))+parseCabalHandleException cabalFile = (Right <$> parseCabalFileExtensions cabalFile)+ `catch` handleCabalException++-- | Handle 'CabalException' and return corresponding 'CabalError'.+handleCabalException+ :: CabalException+ -> IO (Either ExtensionsError (Map FilePath ParsedExtensions))+handleCabalException = pure . Left . CabalError++getCabalAndModuleExts+ :: FilePath+ -> ParsedExtensions+ -> Either ModuleParseError ParsedExtensions+ -> Either ExtensionsError CabalAndModuleExtensions+getCabalAndModuleExts path cabalExts moduleRes = case moduleRes of+ Left err -> Left $ ModuleParseError path err+ Right moduleExts -> Right $ CabalAndModuleExtensions+ { cabalExtensions = cabalExts+ , moduleExtensions = moduleExts+ }
+ src/Extensions/Types.hs view
@@ -0,0 +1,270 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE DeriveAnyClass #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Data types and functions to work with different types of 'Extension's.++@extensions@ library supports the following types of extensions:++ +-------------------------------------------+----------------------------++ | @Haskell2010@ Default Enabled Extensions | 'On' of 'OnOffExtension's |+ +-------------------------------------------+----------------------------++ | @Haskell2010@ Default Disabled Extensions | 'Off' of 'OnOffExtension's |+ +-------------------------------------------+----------------------------++ | @SafeHaskell@ Extensions | 'SafeHaskellExtension's |+ +-------------------------------------------+----------------------------+++-}++module Extensions.Types+ ( Extensions (..)+ , ParsedExtensions (..)+ , CabalAndModuleExtensions (..)+ , ExtensionsResult++ -- * Errors+ , ExtensionsError (..)+ , CabalException (..)+ , ModuleParseError (..)++ -- ** Defaults / empty data types+ , emptyExtensions+ , emptyParsedExtensions++ -- * Enabled/Disabled Haskell2010 Extensions+ , OnOffExtension (..)+ , showOnOffExtension+ , readOnOffExtension+ , readExtension+ , mergeExtensions+ , mergeAnyExtensions+ , default2010Extensions++ -- * Safe Haskell Extensions+ , SafeHaskellExtension (..)+ ) where++import Control.Applicative ((<|>))+import Control.Exception (Exception)+import Data.Foldable (foldl')+import Data.List.NonEmpty (NonEmpty (..))+import Data.Set (Set)+import Data.Text (Text)+import GHC.LanguageExtensions.Type (Extension (..))+import Text.Read (readMaybe)++import qualified Data.Set as Set+import qualified Data.Text as Text+import qualified Text.Parsec as Parsec+++{- | Main returned data type that includes merged 'OnOffExtension's and possibly+one 'SafeHaskellExtension'.+-}+data Extensions = Extensions+ { extensionsAll :: !(Set OnOffExtension)+ , extensionsSafe :: !(Maybe SafeHaskellExtension)+ } deriving stock (Show, Eq)++{- | Extensions that are collected in the result of parsing @.cabal@ file or+Haskell module (both 'OnOffExtension' and possibly one 'SafeHaskellExtension').++'OnOffExtension's are not necessary unique. They reflect exactly the extensions+found during parsing.+-}+data ParsedExtensions = ParsedExtensions+ { parsedExtensionsAll :: ![OnOffExtension]+ , parsedExtensionsSafe :: !(Maybe SafeHaskellExtension)+ } deriving stock (Show, Eq)++-- | Stores extensions from @.cabal@ file and module separately.+data CabalAndModuleExtensions = CabalAndModuleExtensions+ { cabalExtensions :: !ParsedExtensions+ , moduleExtensions :: !ParsedExtensions+ } deriving stock (Show, Eq)++-- | Type alias for the result of extensions analysis.+type ExtensionsResult = Either ExtensionsError Extensions++-- | Represents possible errors during the work of extensions analyser.+data ExtensionsError+ -- | Parse error during module extensions parsing.+ = ModuleParseError FilePath ModuleParseError+ -- | Error during @.cabal@ file reading/parsing.+ | CabalError CabalException+ -- | File is in cabal file, but the source file is not provided where requested.+ | SourceNotFound FilePath+ -- | Source file is provided, but module is not in cabal file.+ | NotCabalModule FilePath+ -- | Conflicting 'SafeHaskellExtension's in one scope.+ | SafeHaskellConflict (NonEmpty SafeHaskellExtension)+ deriving stock (Show, Eq)++{- | Exception that gets thrown when working with @.cabal@ files.+-}+data CabalException+ -- | The @.cabal@ file is not found.+ = CabalFileNotFound FilePath+ -- | Parsing errors in the @.cabal@ file.+ | CabalParseError Text+ -- | Conflicting 'SafeHaskellExtension's in one scope.+ | CabalSafeExtensionsConflict (NonEmpty SafeHaskellExtension)+ deriving stock (Show, Eq)+ deriving anyclass (Exception)++-- | Error while parsing Haskell source file.+data ModuleParseError+ -- | File parsing error.+ = ParsecError Parsec.ParseError+ -- | Uknown extensions were used in the module.+ | UnknownExtensions (NonEmpty String)+ -- | Conflicting 'SafeHaskellExtension's in one scope.+ | ModuleSafeHaskellConflict (NonEmpty SafeHaskellExtension)+ -- | Module file not found.+ | FileNotFound FilePath+ deriving stock (Show, Eq)+++-- | Empty 'Extensions' with no specified 'SafeHaskellExtension'.+emptyExtensions :: Extensions+emptyExtensions = Extensions+ { extensionsAll = mempty+ , extensionsSafe = Nothing+ }++-- | Empty 'ParsedExtensions' with no specified 'SafeHaskellExtension'.+emptyParsedExtensions :: ParsedExtensions+emptyParsedExtensions = ParsedExtensions+ { parsedExtensionsAll = []+ , parsedExtensionsSafe = Nothing+ }++{- | Language extensions that are used by Safe Haskell to indicate safety of the+code.++To find out more, checkout the official documentation on @SafeHaskell@:++ * [Safe Language Pragmas](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/safe_haskell.html#safe-haskell)+-}+data SafeHaskellExtension+ = Unsafe+ | Trustworthy+ | Safe+ deriving stock (Show, Read, Eq, Ord, Enum, Bounded)++-- | Represents enabled/disabled extensions.+data OnOffExtension+ = On Extension+ | Off Extension+ deriving stock (Show, Eq, Ord)++-- | Display 'OnOffExtension' as GHC recognizes it.+showOnOffExtension :: OnOffExtension -> Text+showOnOffExtension = \case+ On ext -> showExtension ext+ Off ext -> "No" <> showExtension ext+ where+ showExtension :: Extension -> Text+ showExtension = \case+ Cpp -> "CPP"+ RecordPuns -> "NamedFieldPuns"+ ext -> Text.pack $ show ext++{- | Parse 'OnOffExtension' from a string that specifies extension.+-}+readOnOffExtension :: String -> Maybe OnOffExtension+readOnOffExtension s =+ (On <$> readExtension s) <|> (Off <$> readOffExtension)+ where+ readOffExtension :: Maybe Extension+ readOffExtension = do+ ("No", ext) <- Just $ splitAt 2 s+ readExtension ext++{- | Parse 'Extension' from a string. 'Read' instance for 'Extension'+doesn't always work since some extensions are named differently.+-}+readExtension :: String -> Maybe Extension+readExtension = \case+ "GeneralisedNewtypeDeriving" -> Just GeneralizedNewtypeDeriving+ "NamedFieldPuns" -> Just RecordPuns+ "RecordPuns" -> Nothing+ "Rank2Types" -> Just RankNTypes+ "CPP" -> Just Cpp+ "Cpp" -> Nothing+ s -> readMaybe s++{- | Take accumulated 'OnOffExtension's, and merge them into one 'Set',+excluding enabling of 'default2010Extensions'.++If the default extension is enabled manually it still won't count as it doesn't+affect real behaviour. However, disabling of default extension will be included+in the list.++So, basically, this set will only have 'On' extensions that are not defaults,+and 'Off' extensions of defaults.++'foldl\'' is used in order to process them in the right order: first all cabal+extensions and then extensions from the module in the order of appearance.+-}+mergeExtensions :: [OnOffExtension] -> Set OnOffExtension+mergeExtensions = foldl' handleExt Set.empty+ where+ handleExt :: Set OnOffExtension -> OnOffExtension -> Set OnOffExtension+ handleExt exts (On e)+ | e `elem` default2010Extensions = Set.delete (Off e) exts+ | otherwise = Set.insert (On e) exts+ handleExt exts (Off e)+ | e `elem` default2010Extensions = Set.insert (Off e) exts+ | otherwise = Set.delete (On e) exts++{- | Similar to 'mergeExtensions', but also merge 'SafeHaskellExtension's.+In case of conflicting 'SafeHaskellExtension' returns 'Left' with the pair of+conflicting extension constructors under 'SafeHaskellConflict' error.+-}+mergeAnyExtensions+ :: ParsedExtensions -- ^ Cabal parsed extensions.+ -> ParsedExtensions -- ^ Module parsed extensions.+ -> ExtensionsResult+mergeAnyExtensions (ParsedExtensions exts1 safe1) (ParsedExtensions exts2 safe2) = case (safe1, safe2) of+ (Nothing, safe) -> Right $ Extensions+ { extensionsAll = mergedExts+ , extensionsSafe = safe+ }+ (safe, Nothing) -> Right $ Extensions+ { extensionsAll = mergedExts+ , extensionsSafe = safe+ }+ (Just s1, Just s2) ->+ if safe1 == safe2+ then Right $ Extensions+ { extensionsAll = mergedExts+ , extensionsSafe = safe1+ }+ else Left $ SafeHaskellConflict $ s1 :| [s2]+ where+ mergedExts :: Set OnOffExtension+ mergedExts = mergeExtensions (exts1 <> exts2)++-- | Default enabled extensions for @Haskell2010@+default2010Extensions :: [Extension]+default2010Extensions =+ [ ImplicitPrelude+ , StarIsType+ , MonomorphismRestriction+ , DatatypeContexts+ , TraditionalRecordSyntax+ , EmptyDataDecls+ , ForeignFunctionInterface+ , PatternGuards+ , DoAndIfThenElse+ , RelaxedPolyRec+ ]++deriving stock instance Read Extension+deriving stock instance Ord Extension
+ test/Spec.hs view
@@ -0,0 +1,16 @@+module Main (main) where++import Test.Hspec (hspec)++import Test.Extensions (getExtensionsSpec)+import Test.Extensions.Cabal (cabalSpec)+import Test.Extensions.Module (moduleParserSpec)+import Test.Extensions.Types (onOffSpec)+++main :: IO ()+main = hspec $ do+ onOffSpec+ cabalSpec+ moduleParserSpec+ getExtensionsSpec
+ test/Test/Extensions.hs view
@@ -0,0 +1,98 @@+module Test.Extensions+ ( getExtensionsSpec+ ) where++import Data.ByteString (ByteString)+import Data.Map.Strict (Map)+import Data.Maybe (fromMaybe)+import Data.Set (Set)+import GHC.LanguageExtensions.Type (Extension (..))+import Test.Hspec (Spec, describe, it, shouldBe)++import Extensions (getModuleExtentions, getModuleExtentionsBySource, getPackageExtentions,+ getPackageExtentionsBySources)+import Extensions.Types (Extensions (..), ExtensionsError (..), ExtensionsResult,+ OnOffExtension (..), ParsedExtensions (..))+import Test.Extensions.Cabal (defaultExtensions)++import qualified Data.ByteString as BS+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+++getExtensionsSpec :: Spec+getExtensionsSpec = describe "Get Extensions" $ do+ it "should getPackageExtensions" $+ getPackageExtentions cabal >>= \res -> res `shouldBe` resultMap+ it "should getPackageExtensionsBySource" $ do+ res <- sources >>= getPackageExtentionsBySources cabal+ res `shouldBe` resultMap+ it "should getPackageExtensionsBySource, return NonCabalModule" $ do+ srcs <- sources+ res <- getPackageExtentionsBySources cabal $+ Map.insert unknownModule "Hello" srcs+ res `shouldBe` Map.insert unknownModule (Left $ NotCabalModule unknownModule) resultMap+ it "should getPackageExtensionsBySource, return SourceNotFound" $ do+ srcs <- sources+ res <- getPackageExtentionsBySources cabal $+ Map.delete knownModule srcs+ res `shouldBe` Map.insert knownModule (Left $ SourceNotFound knownModule) resultMap+ it "should getModuleExtensions" $ do+ res <- getModuleExtentions cabal knownModule+ res `shouldBe` Right exts+ it "should getModuleExtensions, return NotCabalModule" $ do+ res <- getModuleExtentions cabal unknownModule+ res `shouldBe` Left (NotCabalModule unknownModule)+ it "should getModuleExtensionsBySource" $ do+ res <- knownSource >>= getModuleExtentionsBySource cabal knownModule+ res `shouldBe` Right exts+ it "should getModuleExtensions, return NotCabalModule" $ do+ res <- getModuleExtentionsBySource cabal unknownModule "Hello"+ res `shouldBe` Left (NotCabalModule unknownModule)++resultMap :: Map FilePath ExtensionsResult+resultMap = Map.fromList+ [ "app/Cli.hs" `to` Right+ (extsPlus $ Set.singleton (On ApplicativeDo))+ , "app/Main.hs" `to` Right exts+ , "src/Extensions.hs" `to` Right exts+ , "src/Extensions/Cabal.hs" `to` Right+ (extsPlus $ Set.singleton $ On Cpp )+ , "src/Extensions/Module.hs" `to` Right exts+ , "src/Extensions/Package.hs" `to` Right exts+ , "src/Extensions/Types.hs" `to` Right+ (extsPlus $ Set.singleton $ On DeriveAnyClass )+ , "test/Test/Extensions.hs" `to` Right exts+ , "test/Test/Extensions/Cabal.hs" `to` Right exts+ , "test/Test/Extensions/Module.hs" `to` Right exts+ , "test/Test/Extensions/Types.hs" `to` Right exts+ , "test/Spec.hs" `to` Right exts+ ]+ where+ to = (,)++exts :: Extensions+exts = Extensions+ { extensionsAll = Set.fromList $ parsedExtensionsAll defaultExtensions+ , extensionsSafe = Nothing+ }++extsPlus :: Set OnOffExtension -> Extensions+extsPlus s = exts+ { extensionsAll = extensionsAll exts <> s+ }++sources :: IO (Map FilePath ByteString)+sources = Map.traverseWithKey (\f _ -> BS.readFile f) resultMap++cabal :: FilePath+cabal = "extensions.cabal"++unknownModule :: FilePath+unknownModule = "src/Unknown.hs"++knownModule :: FilePath+knownModule = "src/Extensions.hs"++knownSource :: IO ByteString+knownSource = fromMaybe "" . Map.lookup knownModule <$> sources
+ test/Test/Extensions/Cabal.hs view
@@ -0,0 +1,229 @@+module Test.Extensions.Cabal+ ( cabalSpec+ , defaultExtensions+ ) where++import Data.ByteString (ByteString)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict (Map)+import GHC.LanguageExtensions.Type (Extension (..))+import Test.Hspec (Spec, describe, it, shouldBe, shouldThrow)++import Extensions.Cabal (parseCabalExtensions, parseCabalFileExtensions)+import Extensions.Types (CabalException (..), OnOffExtension (..), ParsedExtensions (..),+ SafeHaskellExtension (..), emptyParsedExtensions)++import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+++cabalSpec :: Spec+cabalSpec = describe "Cabal file Extensions Parser" $ do+ it "should throw the 'CabalFileNotFound' exception on non-existing file" $+ parseCabalFileExtensions "xno-extensions.cabal" `shouldThrow`+ (== CabalFileNotFound "xno-extensions.cabal")+ it "should throw 'CabalParseError'" $+ parseCabalExtensions exampleCabal "stack.yaml" `shouldThrow`+ (== CabalParseError "example.cabal:0:0: \"name\" field missing")+ it "should throw 'CabalSafeExtensionsConflict'" $+ parseCabalExtensions exampleCabal conflictSafeCabal `shouldThrow`+ (== CabalSafeExtensionsConflict (Safe :| [Unsafe]))+ it "should parse minimal Cabal file" $+ parseCabalExtensions exampleCabal minimalCabal >>= \extMap ->+ extMap `shouldBe` mempty+ it "should parse Cabal file with a single module in a library" $+ parseCabalExtensions exampleCabal singleModuleCabal >>= \extMap ->+ extMap `shouldBe` singleModuleMap+ it "should parse Cabal file with multiple directories" $+ parseCabalExtensions exampleCabal multipleDirsCabal >>= \extMap ->+ extMap `shouldBe` singleModuleMap+ it "should parse Cabal file with default-extensions" $+ parseCabalExtensions exampleCabal singleExtensionCabal >>= \extMap ->+ extMap `shouldBe` singleExtensionMap+ it "should parse Cabal file with default-extensions inside common stanza" $+ parseCabalExtensions exampleCabal commonStanzaCabal >>= \extMap ->+ extMap `shouldBe` singleExtensionMap+ it "should parse Cabal file with Safe in default-extensions" $+ parseCabalExtensions exampleCabal safeHaskellCabal >>= \extMap ->+ extMap `shouldBe` safeExtensionMap+ it "should parse Cabal file with different safe extensions in different stanzas" $+ parseCabalExtensions exampleCabal manySafeCabal >>= \extMap ->+ extMap `shouldBe` manySafeMap+ it "should parse extensions.cabal" $+ parseCabalFileExtensions "extensions.cabal" >>= \extMap ->+ extMap `shouldBe` expectedMap+ where+ to :: FilePath -> ParsedExtensions -> (FilePath, ParsedExtensions)+ to = (,)++ exampleCabal :: FilePath+ exampleCabal = "example.cabal"++ singleModuleMap :: Map FilePath ParsedExtensions+ singleModuleMap = Map.singleton "src/Extensions.hs" emptyParsedExtensions++ singleExtensionMap :: Map FilePath ParsedExtensions+ singleExtensionMap = Map.singleton "src/Extensions.hs" emptyParsedExtensions+ { parsedExtensionsAll = [On TypeApplications]+ }++ safeExtensionMap :: Map FilePath ParsedExtensions+ safeExtensionMap = Map.singleton "src/Extensions.hs" emptyParsedExtensions+ { parsedExtensionsSafe = Just Safe+ }++ manySafeMap :: Map FilePath ParsedExtensions+ manySafeMap = Map.fromList+ [ "src/Extensions.hs" `to` emptyParsedExtensions+ { parsedExtensionsSafe = Just Safe+ }+ , "test/Spec.hs" `to` emptyParsedExtensions+ { parsedExtensionsSafe = Just Trustworthy+ }+ ]++ -- Map for the project itself+ expectedMap :: Map FilePath ParsedExtensions+ expectedMap = Map.fromList+ [ "app/Cli.hs" `to` defaultExtensions+ , "app/Main.hs" `to` defaultExtensions+ , "src/Extensions.hs" `to` defaultExtensions+ , "src/Extensions/Cabal.hs" `to` defaultExtensions+ , "src/Extensions/Module.hs" `to` defaultExtensions+ , "src/Extensions/Package.hs" `to` defaultExtensions+ , "src/Extensions/Types.hs" `to` defaultExtensions+ , "test/Test/Extensions.hs" `to` defaultExtensions+ , "test/Test/Extensions/Cabal.hs" `to` defaultExtensions+ , "test/Test/Extensions/Module.hs" `to` defaultExtensions+ , "test/Test/Extensions/Types.hs" `to` defaultExtensions+ , "test/Spec.hs" `to` defaultExtensions+ ]++ -- Minimal cabal file with no modules and no extensions+ minimalCabal :: ByteString+ minimalCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "library"+ ]++ -- Cabal file with a single directory and single module+ singleModuleCabal :: ByteString+ singleModuleCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "library"+ , " hs-source-dirs: src"+ , " exposed-modules: Extensions"+ ]++ -- Cabal file with multiple directories+ multipleDirsCabal :: ByteString+ multipleDirsCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "library"+ , " hs-source-dirs: foo, bar, baz, quux, src"+ , " exposed-modules: Extensions"+ ]++ -- Cabal file with a single directory, single module and single extension+ singleExtensionCabal :: ByteString+ singleExtensionCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "library"+ , " hs-source-dirs: src"+ , " exposed-modules: Extensions"+ , " default-extensions: TypeApplications"+ ]++ -- Cabal file with a common stanza+ commonStanzaCabal :: ByteString+ commonStanzaCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "common common-extensions"+ , " default-extensions: TypeApplications"+ , ""+ , "library"+ , " import: common-extensions"+ , " hs-source-dirs: src"+ , " exposed-modules: Extensions"+ ]++ -- Cabal file with safe haskell extension+ safeHaskellCabal :: ByteString+ safeHaskellCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "library"+ , " hs-source-dirs: src"+ , " exposed-modules: Extensions"+ , " default-extensions: Safe"+ ]++ -- Cabal file with conflicting safe haskell extensions+ conflictSafeCabal :: ByteString+ conflictSafeCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "library"+ , " hs-source-dirs: src"+ , " exposed-modules: Extensions"+ , " default-extensions: Safe, Unsafe"+ ]++ -- Cabal file with different Safe extensions+ manySafeCabal :: ByteString+ manySafeCabal = Text.encodeUtf8 $ Text.unlines+ [ "cabal-version: 2.4"+ , "name: example"+ , "version: 0.0.0.0"+ , ""+ , "library"+ , " hs-source-dirs: src"+ , " exposed-modules: Extensions"+ , " default-extensions: Safe"+ , ""+ , "test-suite example-test"+ , " type: exitcode-stdio-1.0"+ , " hs-source-dirs: test"+ , " main-is: Spec.hs"+ , " default-extensions: Trustworthy"+ ]++defaultExtensions :: ParsedExtensions+defaultExtensions = emptyParsedExtensions+ { parsedExtensionsAll = map On+ [ ConstraintKinds+ , DeriveGeneric+ , DerivingStrategies+ , GeneralizedNewtypeDeriving+ , InstanceSigs+ , KindSignatures+ , LambdaCase+ , OverloadedStrings+ , RecordWildCards+ , ScopedTypeVariables+ , StandaloneDeriving+ , TupleSections+ , TypeApplications+ , ViewPatterns+ ]+ }
+ test/Test/Extensions/Module.hs view
@@ -0,0 +1,427 @@+module Test.Extensions.Module+ ( moduleParserSpec+ ) where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (pack)+import Data.Text.Encoding (encodeUtf8)+import GHC.LanguageExtensions.Type (Extension (..))+import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it, shouldBe)++import Extensions.Module (parseFile, parseSource)+import Extensions.Types (ModuleParseError (..), OnOffExtension (..), ParsedExtensions (..),+ SafeHaskellExtension (..), emptyParsedExtensions)+++moduleParserSpec :: Spec+moduleParserSpec = describe "Haskell file Extensions Parser" $ do+ failSpec+ onlyExtensionsSpec+ singleLineCommentsSpec+ multiLineCommentsSpec+ cppSpec+ optionsGhcSpec+ mixSpec++failSpec :: Spec+failSpec = describe "Expected test failures" $ do+ it "should throw FileNotFound" $+ parseFile "Java.hs" >>= \res ->+ res `shouldBe` Left (FileNotFound "Java.hs")+ itShouldFail+ "{-# LANGUAGE DependentTypes #-}"+ (UnknownExtensions $ "DependentTypes" :| [])+ itShouldFail (unlines+ [ "{-# LANGUAGE LambdaCase #-}"+ , "{-# LANGUAGE Cpp #-}"+ ])+ (UnknownExtensions $ "Cpp" :| [])+ itShouldFail (unlines+ [ "{-# LANGUAGE Safe #-}"+ , "{-# LANGUAGE Unsafe #-}"+ ])+ (ModuleSafeHaskellConflict $ Safe :| [Unsafe])+ itShouldFail+ "{-# LANGUAGE Safe, Trustworthy, Unsafe #-}"+ (ModuleSafeHaskellConflict $ Safe :| [Trustworthy, Unsafe])+ itShouldFail+ "{-# LANGUAGE NoSafe #-}"+ (UnknownExtensions $ "NoSafe" :| [])++onlyExtensionsSpec :: Spec+onlyExtensionsSpec = describe "Parsing only extensions without anything else" $ do+ itShouldParse "" []+ itShouldParse "{-# LANGUAGE TypeApplications #-}" [TypeApplications]+ itShouldParse "{-# LaNgUaGe CPP #-}" [Cpp]++ itShouldParseSafe "{-# LANGUAGE Safe #-}" Safe+ itShouldParseSafe "{-# LANGUAGE Trustworthy #-}" Trustworthy+ itShouldParseSafe "{-# LANGUAGE Unsafe #-}" Unsafe+ itShouldParseSafe (unlines+ [ "{-# LANGUAGE Safe #-}"+ , "{-# LANGUAGE Safe #-}"+ ])+ Safe++ itShouldParseOnOff+ "{-# LANGUAGE NoImplicitPrelude #-}"+ [Off ImplicitPrelude]+ itShouldParseOnOff+ "{-# LANGUAGE NondecreasingIndentation #-}"+ [On NondecreasingIndentation]+ itShouldParse "{-#language TypeApplications#-}" [TypeApplications]+ itShouldParse "{-# LANGUAGE TypeApplications, LambdaCase#-}" [TypeApplications, LambdaCase]+ itShouldParse "{-# LANGUAGE TypeApplications , LambdaCase #-}" [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE TypeApplications #-}"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE GeneralizedNewtypeDeriving #-}"+ , "{-# LANGUAGE GeneralisedNewtypeDeriving #-}"+ ])+ [GeneralizedNewtypeDeriving, GeneralizedNewtypeDeriving]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , " TypeApplications,"+ , " LambdaCase "+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , " CPP"+ , " , TypeApplications"+ , " , LambdaCase"+ , "#-}"+ ])+ [Cpp, TypeApplications, LambdaCase]++singleLineCommentsSpec :: Spec+singleLineCommentsSpec = describe "Parsing extensions with single-line comments" $ do+ itShouldParse (unlines+ [ "-- hello"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE LambdaCase #-}"+ , "-- hello "+ ])+ [LambdaCase]+ itShouldParse+ "{-# LANGUAGE LambdaCase #-} -- this is extension for \\case"+ [LambdaCase]+ itShouldParse (unlines+ [ "-- For better syntax"+ , "{-# LANGUAGE LambdaCase #-}"+ , "-- For explicit type annotations"+ , "{-# LANGUAGE TypeApplications #-}"+ ])+ [LambdaCase, TypeApplications]+ itShouldParse (unlines+ [ "-- For better syntax"+ , "{-# LANGUAGE LambdaCase #-} -- this is extension for \\case "+ , "-- For explicit type annotations"+ , "{-# LANGUAGE TypeApplications #-} -- this is extension for @Int"+ ])+ [LambdaCase, TypeApplications]+ itShouldParse (unlines+ [ " -- Comment with indentation"+ , "{-# LANGUAGE LambdaCase #-}"+ , " -- Another comment with indentation"+ , "{-# LANGUAGE TypeApplications #-}"+ ])+ [LambdaCase, TypeApplications]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "-- hello"+ , "LambdaCase "+ , "#-}"+ ])+ [LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "TypeApplications,"+ , "-- hello"+ , "LambdaCase "+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , " TypeApplications,"+ , " -- hello"+ , " LambdaCase "+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , " -- For explicit type annotations"+ , " TypeApplications,"+ , " -- For nicer syntax"+ , " LambdaCase "+ , " -- That's all folks!"+ , "#-}"+ ])+ [TypeApplications, LambdaCase]++multiLineCommentsSpec :: Spec+multiLineCommentsSpec = describe "Parsing extensions with multi-line comments" $ do+ itShouldParse+ "{-# LANGUAGE {- WHAT IS -} LambdaCase {- THIS SYNTAX? o_O -} #-}"+ [LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE TypeApplications , LambdaCase #-}"+ , "{- hello -}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE TypeApplications #-}"+ , "{- hello -}"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse+ "{-# LANGUAGE LambdaCase #-} {- hello -}"+ [LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE TypeApplications #-}"+ , " "+ , "{- hello -}"+ , "{-# LANGUAGE LambdaCase #-}"+ , ""+ , "hello :: IO ()"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE TypeApplications #-}"+ , "{- This is"+ , "a very long"+ , "multiline"+ , "comment"+ , "-}"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE TypeApplications #-} {- Long comment"+ , "explaining why this extension is required -}"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [TypeApplications, LambdaCase]++cppSpec :: Spec+cppSpec = describe "Parsing extensions with CPP" $ do+ itShouldParse (unlines+ [ "#if __GLASGOW_HASKELL__ < 810"+ , "{-# LANGUAGE TypeApplications #-}"+ , "#endif"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "#if __GLASGOW_HASKELL__ < 810"+ , "{-# LANGUAGE TypeApplications #-}"+ , "#else"+ , "{-# LANGUAGE LambdaCase #-}"+ , "#endif"+ , "{-# LANGUAGE DerivingStrategies #-}"+ ])+ [TypeApplications, LambdaCase, DerivingStrategies]+ itShouldParse (unlines+ [ "#if __GLASGOW_HASKELL__ < 810"+ , "{-# LANGUAGE TypeApplications #-}"+ , "{-# LANGUAGE LambdaCase #-}"+ , "#endif"+ , "{-# LANGUAGE DerivingStrategies #-}"+ ])+ [TypeApplications, LambdaCase, DerivingStrategies]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "#if WHAT_IS THIS_SYNTAX o_O"+ , "TypeApplications,"+ , "#else"+ , "LambdaCase"+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "#if WHAT_IS THIS_SYNTAX o_O"+ , " TypeApplications,"+ , "#else"+ , " LambdaCase"+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "#if WHAT_IS THIS_SYNTAX o_O"+ , "TypeApplications,"+ , "#else"+ , "LambdaCase "+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "#if WHAT_IS THIS_SYNTAX o_O"+ , "TypeApplications,"+ , "#else"+ , "LambdaCase"+ , "#endif"+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "#if WHAT_IS THIS_SYNTAX o_O"+ , "TypeApplications,"+ , "#else"+ , "LambdaCase "+ , "#endif"+ , "#-}"+ ])+ [TypeApplications, LambdaCase]++optionsGhcSpec :: Spec+optionsGhcSpec = describe "Parsing LANGUAGE and OPTIONS_GHC pragmas" $ do+ itShouldParse+ "{-# OPTIONS_GHC -fno-warn-orphans #-}"+ []+ itShouldParse+ "{-# options_ghc -freverse-errors #-}"+ []+ itShouldParse+ "{-# OPTIONS_GHC -fno-warn-orphans -freverse-errors #-}"+ []+ itShouldParse (unlines+ [ "{-# OPTIONS_GHC"+ , " -fno-warn-orphans"+ , " -freverse-errors "+ , "#-}"+ ])+ []+ itShouldParse (unlines+ [ "{-# OPTIONS_GHC -fno-warn-orphans #-}"+ , "{-# OPTIONS_GHC -freverse-errors #-}"+ ])+ []+ itShouldParse (unlines+ [ "{-# OPTIONS_GHC -fno-warn-orphans #-}"+ , ""+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [LambdaCase]+ itShouldParse (unlines+ [ "{-# OPTIONS_GHC -fno-warn-orphans #-}"+ , ""+ , "{-# LANGUAGE TypeApplications #-}"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "{-# OPTIONS_GHC -fno-warn-orphans #-}"+ , "{-# LANGUAGE TypeApplications #-}"+ , "{-# OPTIONS_GHC -freverse-errors #-}"+ , "{-# LANGUAGE LambdaCase #-}"+ ])+ [TypeApplications, LambdaCase]++mixSpec :: Spec+mixSpec = describe "Parsing combinations of different parts" $ do+ itShouldParse (unlines+ [ "{-# LANGUAGE TypeApplications, LambdaCase #-}"+ , "{-# language CPP #-}"+ , "{-# LANGUAGE"+ , " DerivingVia,"+ , " DerivingStrategies"+ , "#-}"+ ])+ [TypeApplications, LambdaCase, Cpp, DerivingVia, DerivingStrategies]+ itShouldParse (unlines+ [ "-- first language extension"+ , "{-# LANGUAGE TypeApplications #-} {- this is type applications -}"+ , "{- This is nice syntax for \\case instead of"+ , " case mx of"+ , " Nothing -> ..."+ , " Just x -> ... -}"+ , "{-# LANGUAGE LambdaCase {- CASE -} #-}"+ , " -- That's all folks!"+ , ""+ , "main :: IO ()"+ , "main = putStrLn \"LANGUAGE\""+ ])+ [TypeApplications, LambdaCase]+ itShouldParse (unlines+ [ "-- this is super new extension"+ , "#if __GLASGOW_HASKELL__ < 810"+ , "{-# LANGUAGE TypeApplications #-}"+ , "-- for old GHC versions we can use another one"+ , "#else"+ , "-- or maybe not..."+ , "{-# LANGUAGE LambdaCase #-}"+ , "-- YES!"+ , "#endif"+ , "{- We can also always use strategies -}"+ , "{-# LANGUAGE DerivingStrategies #-}"+ ])+ [TypeApplications, LambdaCase, DerivingStrategies]+ itShouldParse (unlines+ [ "{-# LANGUAGE"+ , "-- this is really weird?"+ , "#if WHAT_IS THIS_SYNTAX o_O"+ , " {- or is it?.. -}"+ , " TypeApplications,"+ , " {- YES! Nobody should write"+ , " such language pragmas!"+ , " -}"+ , "#else"+ , " -- this is fine though"+ , " -- i said, this is fine"+ , " LambdaCase"+ , "#endif"+ , "-- innocent comment at the end"+ , "#-}"+ ])+ [TypeApplications, LambdaCase]+ itShouldParseExtensions (unlines+ [ "{-# LANGUAGE CPP #-}"+ , "#if __GLASGOW_HASKELL__ >= 702"+ , "{-# LANGUAGE Trustworthy #-}"+ , "#endif"+ , ""+ , "-- |"+ , "-- Module : Data.ByteString.Base64"+ ])+ ParsedExtensions+ { parsedExtensionsAll = [On Cpp]+ , parsedExtensionsSafe = Just Trustworthy+ }++itShouldParse :: String -> [Extension] -> SpecWith (Arg Expectation)+itShouldParse s = itShouldParseOnOff s . map On++itShouldParseOnOff :: String -> [OnOffExtension] -> SpecWith (Arg Expectation)+itShouldParseOnOff input res = itShouldParseExtensions input $ emptyParsedExtensions+ { parsedExtensionsAll = res+ }++itShouldParseSafe :: String -> SafeHaskellExtension -> SpecWith (Arg Expectation)+itShouldParseSafe input res = itShouldParseExtensions input $ emptyParsedExtensions+ { parsedExtensionsSafe = Just res+ }++itShouldParseExtensions :: String -> ParsedExtensions -> SpecWith (Arg Expectation)+itShouldParseExtensions input res = it ("should parse:\n" <> indent input) $+ parseSource (encodeUtf8 $ pack input) `shouldBe` Right res++itShouldFail :: String -> ModuleParseError -> SpecWith (Arg Expectation)+itShouldFail input err = it ("should not parse:\n" <> indent input) $+ parseSource (encodeUtf8 $ pack input) `shouldBe` Left err++indent :: String -> String+indent = unlines . map (" " <>) . lines
+ test/Test/Extensions/Types.hs view
@@ -0,0 +1,64 @@+module Test.Extensions.Types+ ( onOffSpec+ ) where++import GHC.LanguageExtensions.Type (Extension (..))+import Hedgehog (Gen, PropertyT, forAll, tripping)+import Test.Hspec (Expectation, Spec, describe, it, shouldBe)+import Test.Hspec.Hedgehog (hedgehog)++import Extensions.Types (OnOffExtension (..), mergeExtensions, readOnOffExtension,+ showOnOffExtension)++import qualified Data.Set as Set+import qualified Data.Text as Text+import qualified Hedgehog.Gen as Gen+++onOffSpec :: Spec+onOffSpec = describe "OnOffExtension tests" $ do+ mergeSpec+ propertiesSpec++mergeSpec :: Spec+mergeSpec = describe "Merging on-off extensions" $ do+ it "should enable non default ext" $+ checkMerge [On LambdaCase] [On LambdaCase]+ it "should not add default ext" $+ checkMerge [On ImplicitPrelude] []+ it "should disable default ext" $+ checkMerge [Off ImplicitPrelude] [Off ImplicitPrelude]+ it "should not affect disabling non default ext" $+ checkMerge [Off LambdaCase] []+ it "should not affect enable+disable non default ext" $+ checkMerge [On LambdaCase, Off LambdaCase] []+ it "should enable when disable+enable non default ext" $+ checkMerge [Off LambdaCase, On LambdaCase] [On LambdaCase]+ it "should not affect disable+enable non default ext" $+ checkMerge [Off ImplicitPrelude, On ImplicitPrelude] []+ it "should enable when disable+enable non default ext" $+ checkMerge [On ImplicitPrelude, Off ImplicitPrelude] [Off ImplicitPrelude]+ where+ checkMerge :: [OnOffExtension] -> [OnOffExtension] -> Expectation+ checkMerge exts res = mergeExtensions exts `shouldBe` Set.fromList res++propertiesSpec :: Spec+propertiesSpec = describe "Property tests" $+ it "read . show ≡ Just" roundtripProperty++roundtripProperty :: PropertyT IO ()+roundtripProperty = hedgehog $ do+ onOffExtension <- forAll genOnOffExtension+ tripping+ onOffExtension+ showOnOffExtension+ (readOnOffExtension . Text.unpack)++genOnOffExtension :: Gen OnOffExtension+genOnOffExtension = Gen.choice+ [ On <$> genExtension+ , Off <$> genExtension+ ]+ where+ genExtension :: Gen Extension+ genExtension = Gen.enumBounded