nixfmt (empty) → 0.3.0
raw patch · 16 files changed
+2421/−0 lines, 16 filesdep +basedep +cmdargsdep +directory
Dependencies added: base, cmdargs, directory, filepath, ghcjs-base, megaparsec, nixfmt, parser-combinators, safe-exceptions, text, unix
Files
- CHANGELOG.md +35/−0
- LICENSE +373/−0
- README.md +58/−0
- js/JSInterface.hs +37/−0
- js/js-interface-wrapper.js +10/−0
- main/Main.hs +138/−0
- main/System/IO/Atomic.hs +90/−0
- main/System/IO/Utf8.hs +88/−0
- nixfmt.cabal +106/−0
- src/Nixfmt.hs +26/−0
- src/Nixfmt/Lexer.hs +99/−0
- src/Nixfmt/Parser.hs +330/−0
- src/Nixfmt/Predoc.hs +290/−0
- src/Nixfmt/Pretty.hs +404/−0
- src/Nixfmt/Types.hs +257/−0
- src/Nixfmt/Util.hs +80/−0
+ CHANGELOG.md view
@@ -0,0 +1,35 @@+<!-- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -->+++# Revision history for nixfmt++## 0.3.0 -- 2019-08-29++* Added check flag for use in CI.+* Added quiet flag to disable all output on stderr.+* Further improved indentation.+* Fixed bugs where Nix code with different semantics was emitted in some cases.++## 0.2.1 -- 2019-07-29++* Fixed missing linebreaks in set abstractions.++## 0.2.0 -- 2019-07-25++* Fixed indentation of binders and some other expressions.+* Use atomic writes to avoid data loss.+* Made idempotent.+* Pinned nixpkgs.+* Simplified some code.+* Many other formatting improvements.++## 0.1.0 -- 2019-05-11++* The first released version of nixfmt. This project aims to provide a+ consistent formatter for Nix code. This release is capable of parsing all of+ nixpkgs and formatting it in a consistent way. The generated code is not yet+ pretty in all places though and there are still some other issues as well.
+ 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,58 @@+<!-- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -->++# `nixfmt`++`nixfmt` is a formatter for Nix code, intended to easily apply a uniform style.++You are encouraged to test this out on your code and submit any undesirable formatting you find as an issue++[](https://buildkite.com/serokell/nixfmt)+[](https://nixfmt.cachix.org)++## Installation++* Optional: `cachix use nixfmt`+* `nix-env -f https://github.com/serokell/nixfmt/archive/master.tar.gz -i`+++## Development++### With Nix++Haskell dependencies will be built by Nix.++* Enter `nix-shell`+* Build with `cabal new-build`++### Without Nix++Haskell dependencies will be bulit by Cabal.++* Build with `cabal new-build`+++## Usage++* `nixfmt < input.nix` – reads Nix code form `stdin`, formats it, and outputs to `stdout`+* `nixfmt file.nix` – format the file in place+++## For Contributors++We welcome issues and pull requests on GitHub.+++## About Serokell++`nixfmt` is maintained and funded with :heart: by+[Serokell](https://serokell.io/). The names and logo for Serokell are trademark+of Serokell OÜ.++We love open source software! See+[our other projects](https://serokell.io/community?utm_source=github) or+[hire us](https://serokell.io/hire-us?utm_source=github) to design, develop and+grow your idea!
+ js/JSInterface.hs view
@@ -0,0 +1,37 @@+{- © 2019 Serokell <hi@serokell.io>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE OverloadedStrings #-}+import GHCJS.Marshal+import GHCJS.Foreign+import GHCJS.Foreign.Callback+import GHCJS.Types+import JavaScript.Object+import qualified JavaScript.Object.Internal as O+import Data.JSString.Text+import qualified Data.JSString as S++import Nixfmt++foreign import javascript unsafe "window.nixfmt_ = $1"+ js_set_logic :: JSVal -> IO ()++main :: IO ()+main = do+ callback <- syncCallback2 ThrowWouldBlock $ \text_ o -> do+ let obj = O.Object o+ Just width <- getProp (textToJSString "width") obj >>= fromJSVal+ Just filename_ <- getProp (textToJSString "filename") obj >>= fromJSVal+ let filename = S.unpack filename_+ let text = textFromJSVal text_+ out <- case format width filename text of+ Left err -> do+ setProp "err" (toJSBool True) obj+ toJSVal $ S.pack $ errorBundlePretty err+ Right out_ -> do+ setProp "err" (toJSBool False) obj+ toJSVal out_+ setProp "ret" out obj+ js_set_logic $ jsval callback
+ js/js-interface-wrapper.js view
@@ -0,0 +1,10 @@+/* © 2019 Serokell <hi@serokell.io>+ *+ * SPDX-License-Identifier: MPL-2.0+ */++function nixfmt(text, width=80, filename="<stdin>") {+ const param = {width, filename}+ nixfmt_(text, param)+ return {text: param.ret, err: param.err}+}
+ main/Main.hs view
@@ -0,0 +1,138 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}++module Main where++import Control.Concurrent (Chan, forkIO, newChan, readChan, writeChan)+import Data.Bifunctor (first)+import Data.Either (lefts)+import Data.Text (Text)+import GHC.IO.Encoding (utf8)+import System.Console.CmdArgs+ (Data, Typeable, args, cmdArgs, help, summary, typ, (&=))+import System.Exit (ExitCode(..), exitFailure, exitSuccess)+import System.IO (hPutStr, hSetEncoding, stderr)+import System.Posix.Process (exitImmediately)+import System.Posix.Signals (Handler(..), installHandler, keyboardSignal)++import qualified Data.Text.IO as TextIO (getContents, hPutStr, putStr)++import Nixfmt+import System.IO.Atomic (withOutputFile)+import System.IO.Utf8 (readFileUtf8, withUtf8StdHandles)++type Result = Either String ()+type Width = Int++data Nixfmt = Nixfmt+ { files :: [FilePath]+ , width :: Width+ , check :: Bool+ , quiet :: Bool+ } deriving (Show, Data, Typeable)++options :: Nixfmt+options = Nixfmt+ { files = [] &= args &= typ "FILES"+ , width = 80 &= help "Maximum width in characters"+ , check = False &= help "Check whether files are formatted"+ , quiet = False &= help "Do not report errors"+ } &= summary "Format Nix source code"++format' :: Width -> FilePath -> Text -> Either String Text+format' w path = first errorBundlePretty . format w path++data Target = Target+ { tDoRead :: IO Text+ , tPath :: FilePath+ , tDoWrite :: Text -> IO ()+ }++formatTarget :: Width -> Target -> IO Result+formatTarget w Target{tDoRead, tPath, tDoWrite} = do+ contents <- tDoRead+ let formatted = format' w tPath contents+ mapM tDoWrite formatted++-- | Return an error if target could not be parsed or was not formatted+-- correctly.+checkTarget :: Width -> Target -> IO Result+checkTarget w Target{tDoRead, tPath} = do+ contents <- tDoRead+ return $ case format' w tPath contents of+ Left err -> Left err+ Right formatted+ | formatted == contents -> Right ()+ | otherwise -> Left $ tPath ++ ":\nnot formatted"++stdioTarget :: Target+stdioTarget = Target TextIO.getContents "<stdin>" TextIO.putStr++fileTarget :: FilePath -> Target+fileTarget path = Target (readFileUtf8 path) path atomicWriteFile+ where+ atomicWriteFile t = withOutputFile path $ \h -> do+ hSetEncoding h utf8+ TextIO.hPutStr h t++toTargets :: Nixfmt -> [Target]+toTargets Nixfmt{ files = [] } = [stdioTarget]+toTargets Nixfmt{ files = paths } = map fileTarget paths++toOperation :: Nixfmt -> Target -> IO Result+toOperation Nixfmt{ width = w, check = True } = checkTarget w+toOperation Nixfmt{ width = w } = formatTarget w++toWriteError :: Nixfmt -> String -> IO ()+toWriteError Nixfmt{ quiet = False } = hPutStr stderr+toWriteError Nixfmt{ quiet = True } = const $ return ()++toJobs :: Nixfmt -> [IO Result]+toJobs opts = map (toOperation opts) $ toTargets opts++-- TODO: Efficient parallel implementation. This is just a sequential stub.+-- This was originally implemented using parallel-io, but it gave a factor two+-- overhead.+doParallel :: [IO a] -> IO [a]+doParallel = sequence++errorWriter :: (String -> IO ()) -> Chan (Maybe String) -> Chan () -> IO ()+errorWriter doWrite chan done = do+ item <- readChan chan+ case item of+ Nothing -> return ()+ Just msg -> doWrite msg >> errorWriter doWrite chan done+ writeChan done ()++writeErrorBundle :: Chan (Maybe String) -> Result -> IO Result+writeErrorBundle chan result = do+ case result of+ Right () -> return ()+ Left err -> writeChan chan $ Just err+ return result++-- | Run a list of jobs and write errors to stderr without interleaving them.+runJobs :: (String -> IO ()) -> [IO Result] -> IO [Result]+runJobs writeError jobs = do+ errChan <- newChan+ doneChan <- newChan+ _ <- forkIO $ errorWriter writeError errChan doneChan+ results <- doParallel $ map (>>= writeErrorBundle errChan) jobs+ writeChan errChan Nothing+ _ <- readChan doneChan+ return results++main :: IO ()+main = withUtf8StdHandles $ do+ _ <- installHandler keyboardSignal+ (Catch (exitImmediately $ ExitFailure 2)) Nothing+ opts <- cmdArgs options+ results <- runJobs (toWriteError opts) (toJobs opts)+ case lefts results of+ [] -> exitSuccess+ _ -> exitFailure
+ main/System/IO/Atomic.hs view
@@ -0,0 +1,90 @@+{- © 2019 Serokell <hi@serokell.io>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++-- | Atomic file IO.+--+-- This modules allows one to replace the contents of a file atomically by+-- leveraging the atomicity of the @rename@ operation.+--+-- This module is a crossover of the `atomic-write` and `safeio` libraries+-- with the fs-related behaviour of the first and interface of the second.+module System.IO.Atomic+ ( withOutputFile+ ) where++import Control.Exception.Safe (mask, onException)+import Control.Monad (when)+import System.Directory (doesFileExist, removeFile, renameFile)+import System.FilePath (takeDirectory, takeFileName)+import System.IO (Handle, hClose, openTempFileWithDefaultPermissions)+import System.Posix.Files (fileMode, getFileStatus, setFileMode)+++-- | Like @withFile@ but replaces the contents atomically.+--+-- This function allocates a temporary file and provides its handle to the+-- IO action. After the action finishes, it /atomically/ replaces the original+-- target file with the temporary one. If the action fails with an exception,+-- the temporary file is cleaned up.+--+-- Since the procedure involves creation of an entirely new file, preserving+-- the attributes is a challenge. This function tries its best, but currently+-- it is Unix-specific and there is definitely room for improvement even on Unix.+withOutputFile ::+ FilePath -- ^ Final file path+ -> (Handle -> IO a) -- ^ IO action that writes to the file+ -> IO a+withOutputFile path act = transact begin commit rollback $ \(tpath, th) -> do+ copyAttributes (tpath, th)+ act th+ where+ tmpDir = takeDirectory path+ tmpTemplate = "." <> takeFileName path <> ".atomic"++ begin :: IO (FilePath, Handle)+ begin = openTempFileWithDefaultPermissions tmpDir tmpTemplate++ -- TODO: Support for non-unix platofrms.+ -- TODO: Preserve ctime?+ -- TODO: Preserve extended attributes (ACLs, ...)?+ copyAttributes :: (FilePath, Handle) -> IO ()+ copyAttributes (tpath, _th) = do+ exists <- doesFileExist path+ when exists $ do+ getFileStatus path >>= setFileMode tpath . fileMode++ commit :: (FilePath, Handle) -> IO ()+ commit (tpath, th) = hClose th *> renameFile tpath path++ rollback :: (FilePath, Handle) -> IO ()+ rollback (tpath, th) = hClose th *> removeFile tpath++++---+-- Helpers+--++-- | A variant of @bracket@ with two different finalisation actions.+--+-- Semantically, the following is /almost/ true:+--+-- > bracket acquire release = transact acquire release release+--+-- except that @bracket@ always runs the cleanup action exactly once, while+-- here, if the action completes but commit fails, we will still run rollback,+-- so there exists an execution in which both finalisation actions are run.+transact ::+ IO a -- ^ computation to run first (\"begin transaction\")+ -> (a -> IO b) -- ^ computation to run on success (\"commit transaction\")+ -> (a -> IO c) -- ^ computation to run on failure (\"rollback transaction\")+ -> (a -> IO d) -- ^ computation to run in-between+ -> IO d -- returns the value from the in-between computation+transact begin commit rollback act =+ mask $ \restore -> do+ a <- begin+ res <- restore (act a) `onException` rollback a+ _ <- commit a `onException` rollback a+ pure res
+ main/System/IO/Utf8.hs view
@@ -0,0 +1,88 @@+{- © 2019 Serokell <hi@serokell.io>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-}++-- | Helpers for implementing tools that process UTF-8 encoded data.+--+-- Standard IO functions assume that the character encoding of the data+-- they read or write is the same as the one used by current locale. In many+-- situtations this assumption is wrong, as tools work with files, and+-- the files nowadays are mostly UTF-8 encoded, regardless of the locale.+-- Therefore, it is almost always a good idea to switch the encoding of+-- file handles to UTF-8.+--+-- The same applies to standard input, output, and error handles. However,+-- there is an edge-case: if they are attached to a terminal, and the+-- encoding is not UTF-8, using UTF-8 might actually be unsafe.+--+-- Functions in this module help deal with all these issues.+module System.IO.Utf8+ ( withUtf8StdHandles++ , openFileUtf8+ , readFileUtf8+ ) where++import Control.Exception (bracket)+import Data.Text (Text)+import GHC.IO.Encoding (mkTextEncoding, textEncodingName, utf8)+import System.IO (stderr, stdin, stdout)++import qualified Data.Text.IO as T+import qualified System.IO as IO+++type EncRestoreAction = IO.Handle -> IO ()++-- | Sets the best available UTF-8-compatible encoding for the handle.+-- Returns the action that will restore the previous one.+--+-- If the handle is in binary mode, does nothing.+-- If the handle is not attached to a terminal, sets UTF-8.+-- Otherwise, keeps its current encoding, but augments it to transliterate+-- unsupported characters.+hSetBestUtf8Enc :: IO.Handle -> IO EncRestoreAction+hSetBestUtf8Enc h = IO.hGetEncoding h >>= \case+ Nothing -> pure (\_ -> pure ())+ Just enc -> do+ isTerm <- IO.hIsTerminalDevice h+ enc' <- chooseBestEnc isTerm enc+ IO.hSetEncoding h enc'+ pure $ flip IO.hSetEncoding enc+ where+ chooseBestEnc False _ = pure utf8+ chooseBestEnc True enc@(textEncodingName -> name)+ | '/' `notElem` name = mkTextEncoding (name ++ "//TRANSLIT")+ | otherwise = pure enc++-- | Configures the encodings of the three standard handles (stdin, stdout, stderr)+-- to work with UTF-8 encoded data and runs the specified IO action.+-- After the action finishes, restores the original encodings.+withUtf8StdHandles :: IO a -> IO a+withUtf8StdHandles action =+ withConfiguredHandle stdin $+ withConfiguredHandle stdout $+ withConfiguredHandle stderr $+ action+ where+ withConfiguredHandle :: IO.Handle -> IO a -> IO a+ withConfiguredHandle h = bracket (hSetBestUtf8Enc h) ($ h) . const++++-- | Like @openFile@, but sets the file encoding to UTF-8, regardless+-- of the current locale.+openFileUtf8 :: IO.FilePath -> IO.IOMode -> IO IO.Handle+openFileUtf8 path mode = do+ h <- IO.openFile path mode+ IO.hSetEncoding h utf8+ pure h++-- | Like @readFile@, but assumes the file is encoded in UTF-8, regardless+-- of the current locale.+readFileUtf8 :: IO.FilePath -> IO Text+readFileUtf8 path = openFileUtf8 path IO.ReadMode >>= T.hGetContents
+ nixfmt.cabal view
@@ -0,0 +1,106 @@+cabal-version: 2.0++-- © 2019 Serokell <hi@serokell.io>+-- © 2019 Lars Jellema <lars.jellema@gmail.com>+--+-- SPDX-License-Identifier: MPL-2.0++name: nixfmt+version: 0.3.0+synopsis: An opinionated formatter for Nix+description:+ A formatter for Nix that ensures consistent and clear formatting by forgetting+ all existing formatting during parsing.+homepage: https://github.com/serokell/nixfmt+bug-reports: https://github.com/serokell/nixfmt/issues+license: MPL-2.0+license-file: LICENSE+author: Lars Jellema+maintainer: lars.jellema@gmail.com+copyright: 2019 Serokell, 2019 Lars Jellema+category: Development+build-type: Simple+extra-source-files: README.md, CHANGELOG.md++source-repository head+ type: git+ location: git://github.com/serokell/nixfmt.git++executable nixfmt+ main-is: Main.hs+ other-modules:+ System.IO.Utf8+ System.IO.Atomic+ other-extensions: DeriveDataTypeable+ hs-source-dirs: main+ if impl(ghcjs)+ buildable: False+ else+ buildable: True+ build-depends:+ base >= 4.12.0 && < 4.13+ , cmdargs >= 0.10.20 && < 0.11+ , nixfmt+ , unix >= 2.7.2 && < 2.8+ , text >= 1.2.3 && < 1.3++ -- for System.IO.Atomic+ , directory >= 1.3.3 && < 1.4+ , filepath >= 1.4.2 && < 1.5+ , safe-exceptions >= 0.1.7 && < 0.2+ default-language: Haskell2010+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -threaded++library+ exposed-modules:+ Nixfmt+ Nixfmt.Lexer+ Nixfmt.Parser+ Nixfmt.Predoc+ Nixfmt.Pretty+ Nixfmt.Types+ Nixfmt.Util+ other-extensions: OverloadedStrings, LambdaCase, FlexibleInstances, DeriveFoldable, DeriveFunctor, StandaloneDeriving+ hs-source-dirs: src+ build-depends:+ base >= 4.12.0 && < 4.13+ , megaparsec >= 7.0.5 && < 7.1+ , parser-combinators >= 1.0.3 && < 1.3+ , text >= 1.2.3 && < 1.3+ default-language: Haskell2010+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -Wno-orphans++executable js-interface+ main-is: JSInterface.hs++ if impl(ghcjs)+ buildable: True+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -Wno-orphans+ build-depends:+ base >= 4.12.0 && < 4.13+ , ghcjs-base >= 0.2.0 && < 0.3+ , nixfmt+ js-sources: js/js-interface-wrapper.js+ hs-source-dirs: js/+ else+ buildable: False++ default-language: Haskell2010
+ src/Nixfmt.hs view
@@ -0,0 +1,26 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++module Nixfmt+ ( errorBundlePretty+ , ParseErrorBundle+ , format+ ) where++import Data.Text (Text)+import Text.Megaparsec (parse)+import Text.Megaparsec.Error (errorBundlePretty)++import Nixfmt.Parser (file)+import Nixfmt.Predoc (layout)+import Nixfmt.Pretty ()+import Nixfmt.Types (ParseErrorBundle)++-- | @format w filename source@ returns either a parsing error specifying a+-- failure in @filename@ or a formatted version of @source@ with a maximum width+-- of @w@ columns where possible.+format :: Int -> FilePath -> Text -> Either ParseErrorBundle Text+format width filename = fmap (layout width) . parse file filename
+ src/Nixfmt/Lexer.hs view
@@ -0,0 +1,99 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE LambdaCase, OverloadedStrings #-}++module Nixfmt.Lexer (lexeme) where++import Data.Char (isSpace)+import Data.List (dropWhileEnd)+import Data.Maybe (fromMaybe)+import Data.Text as Text+ (Text, intercalate, length, lines, null, pack, replace, replicate, strip,+ stripEnd, stripPrefix, stripStart, takeWhile)+import Text.Megaparsec+ (SourcePos(..), anySingle, chunk, getSourcePos, hidden, many, manyTill, some,+ try, unPos, (<|>))+import Text.Megaparsec.Char (eol)++import Nixfmt.Types (Ann(..), Parser, TrailingComment(..), Trivia, Trivium(..))+import Nixfmt.Util (manyP)++data ParseTrivium+ = PTNewlines Int+ | PTLineComment Text+ | PTBlockComment [Text]+ deriving (Show)++preLexeme :: Parser a -> Parser a+preLexeme p = p <* manyP (\x -> isSpace x && x /= '\n' && x /= '\r')++newlines :: Parser ParseTrivium+newlines = PTNewlines <$> Prelude.length <$> some (preLexeme eol)++splitLines :: Text -> [Text]+splitLines = dropWhile Text.null . dropWhileEnd Text.null+ . map Text.stripEnd . Text.lines . replace "\r\n" "\n"++stripIndentation :: Int -> Text -> Text+stripIndentation n t = fromMaybe (stripStart t) $ stripPrefix (Text.replicate n " ") t++commonIndentationLength :: Int -> [Text] -> Int+commonIndentationLength def = foldr min def . map (Text.length . Text.takeWhile (==' '))++fixLines :: Int -> [Text] -> [Text]+fixLines _ [] = []+fixLines n (h : t) = strip h+ : map (stripIndentation $ commonIndentationLength n $ filter (/="") t) t++lineComment :: Parser ParseTrivium+lineComment = preLexeme $ chunk "#" *>+ (PTLineComment <$> manyP (\x -> x /= '\n' && x /= '\r'))++blockComment :: Parser ParseTrivium+blockComment = try $ preLexeme $ do+ _ <- chunk "/*"+ SourcePos{sourceColumn = pos} <- getSourcePos+ chars <- manyTill anySingle $ chunk "*/"+ return $ PTBlockComment $ fixLines (unPos pos) $ splitLines $ pack chars++convertTrailing :: [ParseTrivium] -> Maybe TrailingComment+convertTrailing = toMaybe . join . map toText+ where toText (PTLineComment c) = strip c+ toText (PTBlockComment [c]) = strip c+ toText _ = ""+ join = intercalate " " . filter (/="")+ toMaybe "" = Nothing+ toMaybe c = Just $ TrailingComment c++convertLeading :: [ParseTrivium] -> Trivia+convertLeading = concatMap (\case+ PTNewlines 1 -> []+ PTNewlines _ -> [EmptyLine]+ PTLineComment c -> [LineComment c]+ PTBlockComment [] -> []+ PTBlockComment [c] -> [LineComment $ " " <> strip c]+ PTBlockComment cs -> [BlockComment cs])++isTrailing :: ParseTrivium -> Bool+isTrailing (PTLineComment _) = True+isTrailing (PTBlockComment []) = True+isTrailing (PTBlockComment [_]) = True+isTrailing _ = False++convertTrivia :: [ParseTrivium] -> (Maybe TrailingComment, Trivia)+convertTrivia pts =+ let (trailing, leading) = span isTrailing pts+ in (convertTrailing trailing, convertLeading leading)++trivia :: Parser [ParseTrivium]+trivia = many $ hidden $ lineComment <|> blockComment <|> newlines++lexeme :: Parser a -> Parser (Ann a)+lexeme p = do+ token <- preLexeme p+ (trailing, leading) <- convertTrivia <$> trivia+ return $ Ann token trailing leading
+ src/Nixfmt/Parser.hs view
@@ -0,0 +1,330 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE LambdaCase, OverloadedStrings #-}++module Nixfmt.Parser where++import Prelude hiding (String)++import Control.Monad (guard, liftM2)+import Control.Monad.Combinators (sepBy)+import qualified Control.Monad.Combinators.Expr as MPExpr+ (Operator(..), makeExprParser)+import Data.Char (isAlpha)+import Data.Foldable (toList)+import Data.Maybe (fromMaybe)+import Data.Text as Text+ (Text, cons, empty, null, singleton, split, strip, stripPrefix)+import Text.Megaparsec+ (anySingle, chunk, eof, label, lookAhead, many, notFollowedBy, oneOf,+ optional, satisfy, try, (<|>))+import Text.Megaparsec.Char (char)+import qualified Text.Megaparsec.Char.Lexer as L (decimal, float)++import Nixfmt.Lexer (lexeme)+import Nixfmt.Types+ (Ann, Binder(..), Expression(..), File(..), Fixity(..), Leaf, Operator(..),+ ParamAttr(..), Parameter(..), Parser, Selector(..), SimpleSelector(..),+ String, StringPart(..), Term(..), Token(..), operators, tokenText)+import Nixfmt.Util+ (commonIndentation, identChar, manyP, manyText, pathChar, schemeChar, someP,+ someText, uriChar)++-- HELPER FUNCTIONS++ann :: (a -> b) -> Parser a -> Parser (Ann b)+ann f p = try $ lexeme $ f <$> p++-- | parses a token without parsing trivia after it+rawSymbol :: Token -> Parser Token+rawSymbol t = chunk (tokenText t) *> return t++symbol :: Token -> Parser (Ann Token)+symbol = lexeme . rawSymbol++reservedNames :: [Text]+reservedNames =+ [ "let", "in"+ , "if", "then", "else"+ , "assert"+ , "with"+ , "rec"+ , "inherit"+ ]++reserved :: Token -> Parser (Ann Token)+reserved t = try $ lexeme $ rawSymbol t+ <* lookAhead (satisfy (\x -> not $ identChar x || pathChar x))++-- VALUES++integer :: Parser (Ann Token)+integer = ann Integer L.decimal++float :: Parser (Ann Token)+float = ann Float L.float++identifier :: Parser (Ann Token)+identifier = ann Identifier $ do+ ident <- Text.cons <$> satisfy (\x -> isAlpha x || x == '_')+ <*> manyP identChar+ guard $ not $ ident `elem` reservedNames+ return ident++slash :: Parser Text+slash = chunk "/" <* notFollowedBy (char '/')++envPath :: Parser (Ann Token)+envPath = ann EnvPath $ char '<' *>+ someP pathChar <> manyText (slash <> someP pathChar)+ <* char '>'++path :: Parser (Ann Token)+path = ann Path $ manyP pathChar <> someText (slash <> someP pathChar)++uri :: Parser [[StringPart]]+uri = fmap (pure . pure . TextPart) $ try $+ someP schemeChar <> chunk ":" <> someP uriChar++-- STRINGS++interpolation :: Parser StringPart+interpolation = Interpolation <$>+ symbol TInterOpen <*> expression <*> rawSymbol TInterClose++simpleStringPart :: Parser StringPart+simpleStringPart = TextPart <$> someText (+ chunk "\\n" *> pure "\n" <|>+ chunk "\\r" *> pure "\r" <|>+ chunk "\\t" *> pure "\t" <|>+ chunk "\\" *> (Text.singleton <$> anySingle) <|>+ chunk "$$" <|>+ try (chunk "$" <* notFollowedBy (char '{')) <|>+ someP (\t -> t /= '"' && t /= '\\' && t /= '$'))++indentedStringPart :: Parser StringPart+indentedStringPart = TextPart <$> someText (+ chunk "''\\n" *> pure "\n" <|>+ chunk "''\\r" *> pure "\r" <|>+ chunk "''\\t" *> pure "\t" <|>+ chunk "''\\" *> (Text.singleton <$> anySingle) <|>+ chunk "''$" *> pure "$" <|>+ chunk "'''" *> pure "''" <|>+ chunk "$$" <|>+ try (chunk "$" <* notFollowedBy (char '{')) <|>+ try (chunk "'" <* notFollowedBy (char '\'')) <|>+ someP (\t -> t /= '\'' && t /= '$' && t /= '\n'))++indentedLine :: Parser [StringPart]+indentedLine = many (indentedStringPart <|> interpolation)++isEmptyLine :: [StringPart] -> Bool+isEmptyLine [] = True+isEmptyLine [TextPart t] = Text.null (Text.strip t)+isEmptyLine _ = False++-- | Strip the first line of a string if it is empty.+stripFirstLine :: [[StringPart]] -> [[StringPart]]+stripFirstLine [] = []+stripFirstLine (x : xs)+ | isEmptyLine x = xs+ | otherwise = x : xs++textHeads :: [StringPart] -> [Text]+textHeads line@(TextPart t : _)+ | isEmptyLine line = []+ | otherwise = [t]+textHeads (Interpolation _ _ _ : _) = [""]+textHeads [] = []++stripParts :: Text -> [StringPart] -> [StringPart]+stripParts indentation (TextPart t : xs) =+ TextPart (fromMaybe Text.empty $ Text.stripPrefix indentation t) : xs+stripParts _ xs = xs++-- | Split a list of StringParts on the newlines in their TextParts.+-- Invariant: result is never empty.+splitLines :: [StringPart] -> [[StringPart]]+splitLines [] = [[]]+splitLines (TextPart t : xs) =+ let ts = map (pure . TextPart) $ Text.split (=='\n') t+ in case splitLines xs of+ (xs' : xss) -> init ts ++ ((last ts ++ xs') : xss)+ _ -> error "unreachable"++splitLines (x : xs) =+ case splitLines xs of+ (xs' : xss) -> ((x : xs') : xss)+ _ -> error "unreachable"++stripIndentation :: [[StringPart]] -> [[StringPart]]+stripIndentation parts = case commonIndentation (concatMap textHeads parts) of+ Nothing -> map (const []) parts+ Just indentation -> map (stripParts indentation) parts++dropEmptyParts :: [[StringPart]] -> [[StringPart]]+dropEmptyParts = map $ filter (\case+ TextPart t | Text.null t -> False+ _ -> True)++fixSimpleString :: [StringPart] -> [[StringPart]]+fixSimpleString parts = case splitLines parts of+ [] -> []+ [line] -> [line]+ parts' -> dropEmptyParts (stripIndentation parts')++simpleString :: Parser [[StringPart]]+simpleString = rawSymbol TDoubleQuote *>+ fmap splitLines (many (simpleStringPart <|> interpolation)) <*+ rawSymbol TDoubleQuote++fixIndentedString :: [[StringPart]] -> [[StringPart]]+fixIndentedString = dropEmptyParts . concatMap splitLines . stripIndentation . stripFirstLine++indentedString :: Parser [[StringPart]]+indentedString = rawSymbol TDoubleSingleQuote *>+ fmap fixIndentedString (sepBy indentedLine (chunk "\n")) <*+ rawSymbol TDoubleSingleQuote++string :: Parser String+string = lexeme $ simpleString <|> indentedString <|> uri++-- TERMS++parens :: Parser Term+parens = Parenthesized <$>+ symbol TParenOpen <*> expression <*> symbol TParenClose++selector :: Maybe (Parser Leaf) -> Parser Selector+selector parseDot = Selector <$>+ sequence parseDot <* notFollowedBy path <*>+ ((IDSelector <$> identifier) <|>+ (InterpolSelector <$> lexeme interpolation) <|>+ (StringSelector <$> lexeme simpleString)) <*>+ optional (liftM2 (,) (reserved KOr) term)++selectorPath :: Parser [Selector]+selectorPath = (pure <$> selector Nothing) <>+ many (selector $ Just $ symbol TDot)++simpleTerm :: Parser Term+simpleTerm = (String <$> string) <|>+ (Token <$> (path <|> envPath <|> float <|> integer <|> identifier)) <|>+ parens <|> set <|> list++term :: Parser Term+term = label "term" $ do+ t <- simpleTerm+ s <- many $ try $ selector $ Just $ symbol TDot+ return $ case s of [] -> t+ _ -> Selection t s++-- ABSTRACTIONS++attrParameter :: Maybe (Parser Leaf) -> Parser ParamAttr+attrParameter parseComma = ParamAttr <$>+ identifier <*> optional (liftM2 (,) (symbol TQuestion) expression) <*>+ sequence parseComma++idParameter :: Parser Parameter+idParameter = IDParameter <$> identifier++setParameter :: Parser Parameter+setParameter = SetParameter <$> bopen <*> attrs <*> bclose+ where bopen = symbol TBraceOpen+ bclose = symbol TBraceClose+ commaAttrs = many $ try $ attrParameter $ Just $ symbol TComma+ ellipsis = ParamEllipsis <$> symbol TEllipsis+ lastAttr = attrParameter Nothing <|> ellipsis+ attrs = commaAttrs <> (toList <$> optional (lastAttr))++contextParameter :: Parser Parameter+contextParameter =+ try (ContextParameter <$> setParameter <*> symbol TAt <*> idParameter) <|>+ try (ContextParameter <$> idParameter <*> symbol TAt <*> setParameter)++abstraction :: Parser Expression+abstraction = try (Abstraction <$>+ (contextParameter <|> setParameter <|> idParameter) <*>+ symbol TColon) <*> expression++-- SETS AND LISTS++inherit :: Parser Binder+inherit = Inherit <$> reserved KInherit <*> optional parens <*>+ many identifier <*> symbol TSemicolon++assignment :: Parser Binder+assignment = Assignment <$>+ selectorPath <*> symbol TAssign <*> expression <*> symbol TSemicolon++binders :: Parser [Binder]+binders = many (assignment <|> inherit)++set :: Parser Term+set = Set <$> optional (reserved KRec <|> reserved KLet) <*>+ symbol TBraceOpen <*> binders <*> symbol TBraceClose++list :: Parser Term+list = List <$> symbol TBrackOpen <*> many term <*> symbol TBrackClose++-- OPERATORS++opChars :: [Char]+opChars = "<>=+*/."++operator :: Token -> Parser Leaf+operator t = label "operator" $ try $ lexeme $+ rawSymbol t <* notFollowedBy (oneOf opChars)++opCombiner :: Operator -> MPExpr.Operator Parser Expression+opCombiner Apply = MPExpr.InfixL $ return Application++opCombiner (Op Prefix TMinus) = MPExpr.Prefix $ Negation <$> operator TMinus+opCombiner (Op Prefix TNot) = MPExpr.Prefix $ Inversion <$> operator TNot+opCombiner (Op Prefix _) = undefined++opCombiner (Op Postfix TQuestion) = MPExpr.Postfix $+ (\question sel expr -> MemberCheck expr question sel) <$>+ operator TQuestion <*> selectorPath++opCombiner (Op Postfix _) = undefined++opCombiner (Op InfixL tok) = MPExpr.InfixL $ flip Operation <$> operator tok+opCombiner (Op InfixN tok) = MPExpr.InfixN $ flip Operation <$> operator tok+opCombiner (Op InfixR tok) = MPExpr.InfixR $ flip Operation <$> operator tok++operation :: Parser Expression+operation = MPExpr.makeExprParser+ (Term <$> term <* notFollowedBy (oneOf (":@" :: [Char])))+ (map (map opCombiner) operators)++-- EXPRESSIONS++with :: Parser Expression+with = With <$>+ reserved KWith <*> expression <*> symbol TSemicolon <*> expression++letIn :: Parser Expression+letIn = Let <$> reserved KLet <*> binders <*> reserved KIn <*> expression++ifThenElse :: Parser Expression+ifThenElse = If <$>+ reserved KIf <*> expression <*>+ reserved KThen <*> expression <*>+ reserved KElse <*> expression++assert :: Parser Expression+assert = Assert <$> reserved KAssert <*> expression <*>+ symbol TSemicolon <*> expression++expression :: Parser Expression+expression = label "expression" $ try operation <|> abstraction <|>+ with <|> letIn <|> ifThenElse <|> assert++file :: Parser File+file = File <$> lexeme (return SOF) <*> expression <* eof
+ src/Nixfmt/Predoc.hs view
@@ -0,0 +1,290 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE DeriveFoldable, DeriveFunctor, FlexibleInstances,+ OverloadedStrings, StandaloneDeriving #-}++-- | This module implements a layer around the prettyprinter package, making it+-- easier to use.+module Nixfmt.Predoc+ ( text+ , sepBy+ , hcat+ , base+ , group+ , nest+ , softline'+ , line'+ , softline+ , line+ , hardspace+ , hardline+ , emptyline+ , newline+ , Doc+ , Pretty+ , pretty+ , fixup+ , layout+ , textWidth+ ) where++import Data.List (intersperse)+import Data.Text as Text (Text, concat, length, pack, replicate)++-- | Sequential Spacings are reduced to a single Spacing by taking the maximum.+-- This means that e.g. a Space followed by an Emptyline results in just an+-- Emptyline.+data Spacing+ = Softbreak+ | Break+ | Hardspace+ | Softspace+ | Space+ | Hardline+ | Emptyline+ | Newlines Int+ deriving (Show, Eq, Ord)++data DocAnn+ -- | Node Group docs indicates either all or none of the Spaces and Breaks+ -- in docs should be converted to line breaks.+ = Group+ -- | Node (Nest n) doc indicates all line starts in doc should be indented+ -- by n more spaces than the surrounding Base.+ | Nest Int+ -- | Node Base doc sets the base indentation that Nests should be relative+ -- to to the indentation of the line where the Base starts.+ | Base+ deriving (Show, Eq)++-- | Single document element. Documents are modeled as lists of these elements+-- in order to make concatenation simple.+data DocE+ = Text Text+ | Spacing Spacing+ | Node DocAnn Doc+ deriving (Show, Eq)++type Doc = [DocE]++class Pretty a where+ pretty :: a -> Doc++instance Pretty Text where+ pretty = pure . Text++instance Pretty String where+ pretty = pure . Text . pack++instance Pretty Doc where+ pretty = id++instance Pretty a => Pretty (Maybe a) where+ pretty Nothing = mempty+ pretty (Just x) = pretty x++text :: Text -> Doc+text "" = []+text t = [Text t]++group :: Pretty a => a -> Doc+group = pure . Node Group . pretty++-- | @nest n doc@ sets the indentation for lines in @doc@ to @n@ more than the+-- indentation of the part before it. This is based on the actual indentation of+-- the line, rather than the indentation it should have used: If multiple+-- indentation levels start on the same line, only the last indentation level+-- will be applied on the next line. This prevents unnecessary nesting.+nest :: Int -> Doc -> Doc+nest level = pure . Node (Nest level)++base :: Doc -> Doc+base = pure . Node Base++softline' :: Doc+softline' = [Spacing Softbreak]++line' :: Doc+line' = [Spacing Break]++softline :: Doc+softline = [Spacing Softspace]++line :: Doc+line = [Spacing Space]++hardspace :: Doc+hardspace = [Spacing Hardspace]++hardline :: Doc+hardline = [Spacing Hardline]++emptyline :: Doc+emptyline = [Spacing Emptyline]++newline :: Doc+newline = [Spacing (Newlines 1)]++sepBy :: Pretty a => Doc -> [a] -> Doc+sepBy separator = mconcat . intersperse separator . map pretty++-- | Concatenate documents horizontally without spacing.+hcat :: Pretty a => [a] -> Doc+hcat = mconcat . map pretty++isSpacing :: DocE -> Bool+isSpacing (Spacing _) = True+isSpacing _ = False++spanEnd :: (a -> Bool) -> [a] -> ([a], [a])+spanEnd p = fmap reverse . span p . reverse++-- | Fix up a Doc in multiple stages:+-- - First, all spacings are moved out of Groups and Nests and empty Groups and+-- Nests are removed.+-- - Now, all consecutive Spacings are ensured to be in the same list, so each+-- sequence of Spacings can be merged into a single one.+-- - Finally, Spacings right before a Nest should be moved inside in order to+-- get the right indentation.+fixup :: Doc -> Doc+fixup = moveLinesIn . mergeLines . concatMap moveLinesOut++moveLinesOut :: DocE -> Doc+moveLinesOut (Node ann xs) =+ let movedOut = concatMap moveLinesOut xs+ (pre, rest) = span isSpacing movedOut+ (post, body) = spanEnd isSpacing rest+ in case body of+ [] -> pre ++ post+ _ -> pre ++ (Node ann body : post)++moveLinesOut x = [x]++mergeSpacings :: Spacing -> Spacing -> Spacing+mergeSpacings x y | x > y = mergeSpacings y x+mergeSpacings Break Softspace = Space+mergeSpacings Break Hardspace = Space+mergeSpacings Softbreak Hardspace = Softspace+mergeSpacings (Newlines x) (Newlines y) = Newlines (x + y)+mergeSpacings Emptyline (Newlines x) = Newlines (x + 2)+mergeSpacings Hardspace (Newlines x) = Newlines x+mergeSpacings _ (Newlines x) = Newlines (x + 1)+mergeSpacings _ y = y++mergeLines :: Doc -> Doc+mergeLines [] = []+mergeLines (Spacing a : Spacing b : xs) = mergeLines $ Spacing (mergeSpacings a b) : xs+mergeLines (Text a : Text b : xs) = mergeLines $ Text (a <> b) : xs+mergeLines (Node ann xs : ys) = Node ann (mergeLines xs) : mergeLines ys+mergeLines (x : xs) = x : mergeLines xs++moveLinesIn :: Doc -> Doc+moveLinesIn [] = []+moveLinesIn (Spacing l : Node (Nest level) xs : ys) =+ Node (Nest level) (Spacing l : moveLinesIn xs) : moveLinesIn ys++moveLinesIn (Node ann xs : ys) =+ Node ann (moveLinesIn xs) : moveLinesIn ys++moveLinesIn (x : xs) = x : moveLinesIn xs++layout :: Pretty a => Int -> a -> Text+layout w = layoutGreedy w . fixup . pretty++-- 1. Move and merge Spacings.+-- 2. Convert Softlines to Grouped Lines and Hardspaces to Texts.+-- 3. For each Text or Group, try to fit as much as possible on a line+-- 4. For each Group, if it fits on a single line, render it that way.+-- 5. If not, convert lines to hardlines and unwrap the group++-- | To support i18n, this function needs to be patched.+textWidth :: Text -> Int+textWidth = Text.length++-- | Attempt to fit a list of documents in a single line of a specific width.+fits :: Int -> Doc -> Maybe Text+fits c _ | c < 0 = Nothing+fits _ [] = Just ""+fits c (x:xs) = case x of+ Text t -> (t<>) <$> fits (c - textWidth t) xs+ Spacing Softbreak -> fits c xs+ Spacing Break -> fits c xs+ Spacing Softspace -> (" "<>) <$> fits (c - 1) xs+ Spacing Space -> (" "<>) <$> fits (c - 1) xs+ Spacing Hardspace -> (" "<>) <$> fits (c - 1) xs+ Spacing Hardline -> Nothing+ Spacing Emptyline -> Nothing+ Spacing (Newlines _) -> Nothing+ Node _ ys -> fits c $ ys ++ xs++-- | Find the width of the first line in a list of documents, using target+-- width 0, which always forces line breaks when possible.+firstLineWidth :: Doc -> Int+firstLineWidth [] = 0+firstLineWidth (Text t : xs) = textWidth t + firstLineWidth xs+firstLineWidth (Spacing Hardspace : xs) = 1 + firstLineWidth xs+firstLineWidth (Spacing _ : _) = 0+firstLineWidth (Node _ xs : ys) = firstLineWidth (xs ++ ys)++-- | Check if the first line in a list of documents fits a target width given+-- a maximum width, without breaking up groups.+firstLineFits :: Int -> Int -> Doc -> Bool+firstLineFits targetWidth maxWidth docs = go maxWidth docs+ where go c _ | c < 0 = False+ go c [] = maxWidth - c <= targetWidth+ go c (Text t : xs) = go (c - textWidth t) xs+ go c (Spacing Hardspace : xs) = go (c - 1) xs+ go c (Spacing _ : _) = maxWidth - c <= targetWidth+ go c (Node Group ys : xs) =+ case fits (c - firstLineWidth xs) ys of+ Nothing -> go c (ys ++ xs)+ Just t -> go (c - textWidth t) xs++ go c (Node _ ys : xs) = go c (ys ++ xs)++-- |+data Chunk = Chunk Int DocE++indent :: Int -> Int -> Text+indent n i = Text.replicate n "\n" <> Text.replicate i " "++unChunk :: Chunk -> DocE+unChunk (Chunk _ doc) = doc++-- tw Target Width+-- cc Current Column+-- ci Current Indentation+-- ti Target Indentation+layoutGreedy :: Int -> Doc -> Text+layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node Group doc]+ where go _ _ [] = []+ go cc ci (Chunk ti x : xs) = case x of+ Text t -> t : go (cc + textWidth t) ci xs++ Spacing Break -> indent 1 ti : go ti ti xs+ Spacing Space -> indent 1 ti : go ti ti xs+ Spacing Hardspace -> " " : go (cc + 1) ci xs+ Spacing Hardline -> indent 1 ti : go ti ti xs+ Spacing Emptyline -> indent 2 ti : go ti ti xs+ Spacing (Newlines n) -> indent n ti : go ti ti xs++ Spacing Softbreak+ | firstLineFits (tw - cc) (tw - ti) (map unChunk xs)+ -> go cc ci xs+ | otherwise -> indent 1 ti : go ti ti xs++ Spacing Softspace+ | firstLineFits (tw - cc - 1) (tw - ti) (map unChunk xs)+ -> " " : go (cc + 1) ci xs+ | otherwise -> indent 1 ti : go ti ti xs++ Node (Nest l) ys -> go cc ci $ map (Chunk (ti + l)) ys ++ xs+ Node Base ys -> go cc ci $ map (Chunk ci) ys ++ xs+ Node Group ys ->+ case fits (tw - cc - firstLineWidth (map unChunk xs)) ys of+ Nothing -> go cc ci $ map (Chunk ti) ys ++ xs+ Just t -> t : go (cc + textWidth t) ci xs
+ src/Nixfmt/Pretty.hs view
@@ -0,0 +1,404 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE FlexibleInstances, LambdaCase, OverloadedStrings #-}++module Nixfmt.Pretty where++import Prelude hiding (String)++import Data.Char (isSpace)+import Data.Maybe (fromMaybe)+import Data.Text (Text, isPrefixOf, isSuffixOf, stripPrefix)+import qualified Data.Text as Text+ (dropEnd, empty, init, isInfixOf, last, null, replace, strip, takeWhile)++import Nixfmt.Predoc+ (Doc, Pretty, base, emptyline, group, hardline, hardspace, hcat, line, line',+ nest, newline, pretty, sepBy, softline, softline', text, textWidth)+import Nixfmt.Types+ (Ann(..), Binder(..), Expression(..), File(..), Leaf, ParamAttr(..),+ Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..),+ Token(..), TrailingComment(..), Trivia, Trivium(..), tokenText)+import Nixfmt.Util (commonIndentation)++prettyCommentLine :: Text -> Doc+prettyCommentLine l+ | Text.null l = emptyline+ | otherwise = text l <> hardline++toLineComment :: Text -> Trivium+toLineComment c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c++instance Pretty TrailingComment where+ pretty (TrailingComment c)+ = hardspace <> text "#" <> hardspace <> text c <> hardline++instance Pretty Trivium where+ pretty EmptyLine = emptyline+ pretty (LineComment c) = text "#" <> pretty c <> hardline+ pretty (BlockComment c)+ | all ("*" `isPrefixOf`) (tail c) = hcat (map toLineComment c)+ | otherwise+ = base $ text "/*" <> hardspace+ <> nest 3 (hcat (map prettyCommentLine c))+ <> text "*/" <> hardline++instance Pretty [Trivium] where+ pretty [] = mempty+ pretty trivia = hardline <> hcat trivia++instance Pretty a => Pretty (Ann a) where+ pretty (Ann x trailing leading)+ = pretty x <> pretty trailing <> pretty leading++instance Pretty SimpleSelector where+ pretty (IDSelector i) = pretty i+ pretty (InterpolSelector interpol) = pretty interpol+ pretty (StringSelector (Ann s trailing leading))+ = prettySimpleString s <> pretty trailing <> pretty leading++instance Pretty Selector where+ pretty (Selector dot sel Nothing)+ = pretty dot <> pretty sel++ pretty (Selector dot sel (Just (kw, def)))+ = pretty dot <> pretty sel+ <> hardspace <> pretty kw <> hardspace <> pretty def++instance Pretty Binder where+ pretty (Inherit inherit Nothing ids semicolon)+ = base $ group (pretty inherit <> softline+ <> nest 2 (sepBy softline ids)) <> pretty semicolon++ pretty (Inherit inherit source ids semicolon)+ = base $ group (pretty inherit <> hardspace+ <> pretty source <> line+ <> nest 2 (sepBy softline ids)) <> pretty semicolon++ pretty (Assignment selectors assign expr semicolon)+ = base $ group (hcat selectors <> hardspace+ <> nest 2 (pretty assign <> softline <> pretty expr))+ <> pretty semicolon++-- | Pretty print a term without wrapping it in a group.+prettyTerm :: Term -> Doc+prettyTerm (Token t) = pretty t+prettyTerm (String s) = pretty s+prettyTerm (Selection term selectors) = pretty term <> hcat selectors++prettyTerm (List (Ann paropen Nothing []) [] parclose)+ = pretty paropen <> hardspace <> pretty parclose++prettyTerm (List (Ann paropen Nothing []) [item] parclose)+ | isAbsorbable item+ = pretty paropen <> pretty item <> pretty parclose++prettyTerm (List (Ann paropen trailing leading) items parclose)+ = base $ pretty paropen <> pretty trailing <> line+ <> nest 2 (pretty leading <> sepBy line (map group items)) <> line+ <> pretty parclose++prettyTerm (Set Nothing (Ann paropen Nothing []) [] parclose)+ = pretty paropen <> hardspace <> pretty parclose++prettyTerm (Set krec (Ann paropen trailing leading) binders parclose)+ = base $ pretty (fmap ((<>hardspace) . pretty) krec)+ <> pretty paropen <> pretty trailing <> line+ <> nest 2 (pretty leading <> sepBy hardline binders) <> line+ <> pretty parclose++prettyTerm (Parenthesized paropen expr parclose)+ = base $ pretty paropen <> nest 2 (group expr) <> pretty parclose++instance Pretty Term where+ pretty l@(List _ _ _) = group $ prettyTerm l+ pretty x = prettyTerm x++toLeading :: Maybe TrailingComment -> Trivia+toLeading Nothing = []+toLeading (Just (TrailingComment c)) = [LineComment (" " <> c)]++prettyComma :: Maybe Leaf -> Doc+prettyComma Nothing = mempty+prettyComma (Just comma) = softline' <> pretty comma <> hardspace++instance Pretty ParamAttr where+ pretty (ParamAttr name Nothing comma)+ = pretty name <> prettyComma comma++ pretty (ParamAttr name (Just (qmark, def)) comma)+ = group (pretty name <> hardspace <> pretty qmark+ <> absorb softline mempty (Just 2) def)+ <> prettyComma comma++ pretty (ParamEllipsis ellipsis)+ = pretty ellipsis++instance Pretty Parameter where+ pretty (IDParameter i) = pretty i+ pretty (SetParameter bopen attrs bclose)+ = group $ pretty bopen <> hardspace+ <> hcat attrs <> softline+ <> pretty bclose++ pretty (ContextParameter param1 at param2)+ = pretty param1 <> pretty at <> pretty param2++isAbsorbable :: Term -> Bool+isAbsorbable (String (Ann parts@(_:_:_) _ _))+ = not $ isSimpleString parts+isAbsorbable (Set _ _ (_:_) _) = True+isAbsorbable (List (Ann _ Nothing []) [item] _) = isAbsorbable item+isAbsorbable (Parenthesized (Ann _ Nothing []) (Term t) _) = isAbsorbable t+isAbsorbable (List _ (_:_:_) _) = True+isAbsorbable _ = False++absorb :: Doc -> Doc -> Maybe Int -> Expression -> Doc+absorb left right _ (Term t)+ | isAbsorbable t = toHardspace left <> prettyTerm t <> toHardspace right+ where toHardspace x | x == mempty = mempty+ | x == softline' = mempty+ | x == line' = mempty+ | otherwise = hardspace++absorb left right Nothing x = left <> pretty x <> right+absorb left right (Just level) x+ = left <> nest level (pretty x) <> right++absorbSet :: Expression -> Doc+absorbSet = absorb line mempty Nothing++absorbThen :: Expression -> Doc+absorbThen (Term t) | isAbsorbable t = hardspace <> prettyTerm t <> hardspace+absorbThen x = line <> nest 2 (group x) <> line++absorbElse :: Expression -> Doc+absorbElse (If if_ cond then_ expr0 else_ expr1)+ = hardspace <> pretty if_ <> hardspace <> group cond <> hardspace+ <> pretty then_ <> absorbThen expr0+ <> pretty else_ <> absorbElse expr1++absorbElse (Term t) | isAbsorbable t = hardspace <> prettyTerm t+absorbElse x = line <> nest 2 (group x)++absorbApp :: Expression -> Doc+absorbApp (Application f x) = softline <> pretty f <> absorbApp x+absorbApp (Term t) | isAbsorbable t = hardspace <> group (prettyTerm t)+absorbApp x = softline <> pretty x++instance Pretty Expression where+ pretty (Term t) = pretty t++ pretty (With with expr0 semicolon expr1)+ = base (pretty with <> hardspace+ <> nest 2 (group expr0) <> pretty semicolon)+ <> absorbSet expr1++ pretty (Let (Ann let_ letTrailing letLeading) binders+ (Ann in_ inTrailing inLeading) expr)+ = base $ group letPart <> line <> group inPart+ where letPart = pretty let_ <> pretty letTrailing <> line <> letBody+ inPart = pretty in_ <> hardspace <> pretty expr+ letBody = nest 2 $+ pretty letLeading+ <> sepBy hardline binders+ <> pretty (toLeading inTrailing)+ <> pretty inLeading++ pretty (Assert assert cond semicolon expr)+ = base (pretty assert <> hardspace+ <> nest 2 (group cond) <> pretty semicolon)+ <> absorbSet expr++ pretty (If if_ cond then_ expr0 else_ expr1)+ = base $ group $+ pretty if_ <> hardspace <> group cond <> hardspace+ <> pretty then_ <> absorbThen expr0+ <> pretty else_ <> absorbElse expr1++ pretty (Abstraction (IDParameter param) colon body)+ = pretty param <> pretty colon <> absorbAbs body+ where absorbAbs (Abstraction (IDParameter param0) colon0 body0) =+ hardspace <> pretty param0 <> pretty colon0 <> absorbAbs body0+ absorbAbs x = absorbSet x++ pretty (Abstraction param colon body)+ = pretty param <> pretty colon <> absorbSet body++ pretty (Application f x) = group $ pretty f <> absorbApp x++ pretty (Operation a op b)+ = pretty a <> softline+ <> pretty op <> hardspace <> pretty b++ pretty (MemberCheck expr qmark sel)+ = pretty expr <> softline+ <> pretty qmark <> hardspace <> hcat sel++ pretty (Negation minus expr)+ = pretty minus <> pretty expr++ pretty (Inversion bang expr)+ = pretty bang <> pretty expr++instance Pretty File where+ pretty (File (Ann _ Nothing leading) expr)+ = group $ hcat leading <> pretty expr <> hardline++ pretty (File (Ann _ (Just (TrailingComment trailing)) leading) expr)+ = group $ text "# " <> pretty trailing <> hardline+ <> hcat leading <> pretty expr <> hardline++instance Pretty Token where+ pretty = text . tokenText++instance Pretty [Token] where+ pretty = hcat++-- STRINGS++isSimpleSelector :: Selector -> Bool+isSimpleSelector (Selector _ (IDSelector _) Nothing) = True+isSimpleSelector _ = False++isSimple :: Expression -> Bool+isSimple (Term (Token (Ann (Identifier _) Nothing []))) = True+isSimple (Term (Selection t selectors))+ = isSimple (Term t) && all isSimpleSelector selectors+isSimple _ = False++hasQuotes :: [StringPart] -> Bool+hasQuotes [] = False+hasQuotes (TextPart x : xs) = Text.isInfixOf "\"" x || hasQuotes xs+hasQuotes (_ : xs) = hasQuotes xs++hasDualQuotes :: [StringPart] -> Bool+hasDualQuotes [] = False+hasDualQuotes (TextPart x : xs) = Text.isInfixOf "''" x || hasDualQuotes xs+hasDualQuotes (_ : xs) = hasDualQuotes xs++endsInSingleQuote :: [StringPart] -> Bool+endsInSingleQuote [] = False+endsInSingleQuote xs =+ case last xs of+ (TextPart x) -> x /= Text.empty && Text.last x == '\''+ _ -> False++isIndented :: [[StringPart]] -> Bool+isIndented parts =+ case commonIndentation inits of+ Just "" -> False+ _ -> True+ where textInit (TextPart t : xs) = t <> textInit xs+ textInit _ = ""+ nonEmpty (TextPart "" : xs) = nonEmpty xs+ nonEmpty [] = False+ nonEmpty _ = True+ inits = map textInit $ filter nonEmpty parts++isEmptyLine :: [StringPart] -> Bool+isEmptyLine [] = True+isEmptyLine [TextPart t] = Text.null $ Text.strip t+isEmptyLine _ = False++isSimpleString :: [[StringPart]] -> Bool+isSimpleString [parts]+ | hasDualQuotes parts = True+ | endsInSingleQuote parts = True+ | isIndented [parts] = True+ | hasQuotes parts = False+ | otherwise = True++isSimpleString parts+ | all isEmptyLine parts = True+ | isIndented parts = True+ | otherwise = False++instance Pretty StringPart where+ pretty (TextPart t) = text t+ pretty (Interpolation paropen (Term t) parclose)+ | isAbsorbable t+ = group $ pretty paropen <> prettyTerm t <> pretty parclose++ pretty (Interpolation paropen expr parclose)+ | isSimple expr+ = pretty paropen <> pretty expr <> pretty parclose+ | otherwise+ = group $ pretty paropen <> line'+ <> nest 2 (pretty expr) <> line'+ <> pretty parclose++instance Pretty [StringPart] where+ pretty [Interpolation paropen expr parclose]+ = group $ pretty paropen <> pretty expr <> pretty parclose++ pretty (TextPart t : parts)+ = text t <> nest indentation (hcat parts)+ where indentation = textWidth $ Text.takeWhile isSpace t++ pretty parts = hcat parts++instance Pretty [[StringPart]] where+ pretty parts+ | isSimpleString parts = prettySimpleString parts+ | otherwise = prettyIndentedString parts++type UnescapeInterpol = Text -> Text+type EscapeText = Text -> Text++prettyLine :: EscapeText -> UnescapeInterpol -> [StringPart] -> Doc+prettyLine escapeText unescapeInterpol+ = pretty . unescapeInterpols . map escape+ where escape (TextPart t) = TextPart (escapeText t)+ escape x = x++ unescapeInterpols [] = []+ unescapeInterpols (TextPart t : TextPart u : xs)+ = unescapeInterpols (TextPart (t <> u) : xs)+ unescapeInterpols (TextPart t : xs@(Interpolation _ _ _ : _))+ = TextPart (unescapeInterpol t) : unescapeInterpols xs+ unescapeInterpols (x : xs) = x : unescapeInterpols xs++prettySimpleString :: [[StringPart]] -> Doc+prettySimpleString parts = group $+ text "\""+ <> (sepBy (text "\\n") (map (prettyLine escape unescapeInterpol) parts))+ <> text "\""+ where escape+ = Text.replace "$\\${" "$${"+ . Text.replace "${" "\\${"+ . Text.replace "\"" "\\\""+ . Text.replace "\r" "\\r"+ . Text.replace "\\" "\\\\"++ unescapeInterpol t+ | "$" `isSuffixOf` t = Text.init t <> "\\$"+ | otherwise = t++prettyIndentedString :: [[StringPart]] -> Doc+prettyIndentedString parts = group $ base $+ text "''" <> line'+ <> nest 2 (sepBy newline (map (prettyLine escape unescapeInterpol) parts))+ <> text "''"+ where escape+ = Text.replace "$''${" "$${"+ . Text.replace "${" "''${"+ . Text.replace "''" "'''"++ unescapeInterpol t+ | Text.null t = t+ | Text.last t /= '$' = t+ | trailingQuotes (Text.init t) `mod` 3 == 0+ = Text.init t <> "''$"+ | trailingQuotes (Text.init t) `mod` 3 == 1+ = Text.dropEnd 2 t <> "''\\'''$"+ | otherwise+ = error "should never happen after escape"++ trailingQuotes t+ | "'" `isSuffixOf` t = 1 + trailingQuotes (Text.init t)+ | otherwise = 0 :: Int
+ src/Nixfmt/Types.hs view
@@ -0,0 +1,257 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++{-# LANGUAGE OverloadedStrings #-}++module Nixfmt.Types where++import Prelude hiding (String)++import Data.Text (Text, pack)+import Data.Void (Void)+import qualified Text.Megaparsec as MP (ParseErrorBundle, Parsec)++-- | A @megaparsec@ @ParsecT@ specified for use with @nixfmt@.+type Parser = MP.Parsec Void Text++-- | A @megaparsec@ @ParseErrorBundle@ specified for use with @nixfmt@.+type ParseErrorBundle = MP.ParseErrorBundle Text Void++data Trivium+ = EmptyLine+ | LineComment Text+ | BlockComment [Text]+ deriving (Show)++type Trivia = [Trivium]++newtype TrailingComment = TrailingComment Text deriving (Show)++data Ann a+ = Ann a (Maybe TrailingComment) Trivia+ deriving (Show)++type Leaf = Ann Token++data StringPart+ = TextPart Text+ | Interpolation Leaf Expression Token+ deriving (Show)++type String = Ann [[StringPart]]++data SimpleSelector+ = IDSelector Leaf+ | InterpolSelector (Ann StringPart)+ | StringSelector String+ deriving (Show)++data Selector+ = Selector (Maybe Leaf) SimpleSelector (Maybe (Leaf, Term))+ deriving (Show)++data Binder+ = Inherit Leaf (Maybe Term) [Leaf] Leaf+ | Assignment [Selector] Leaf Expression Leaf+ deriving (Show)++data Term+ = Token Leaf+ | String String+ | List Leaf [Term] Leaf+ | Set (Maybe Leaf) Leaf [Binder] Leaf+ | Selection Term [Selector]+ | Parenthesized Leaf Expression Leaf+ deriving (Show)++data ParamAttr+ = ParamAttr Leaf (Maybe (Leaf, Expression)) (Maybe Leaf)+ | ParamEllipsis Leaf+ deriving (Show)++data Parameter+ = IDParameter Leaf+ | SetParameter Leaf [ParamAttr] Leaf+ | ContextParameter Parameter Leaf Parameter+ deriving (Show)++data Expression+ = Term Term+ | With Leaf Expression Leaf Expression+ | Let Leaf [Binder] Leaf Expression+ | Assert Leaf Expression Leaf Expression+ | If Leaf Expression Leaf Expression Leaf Expression+ | Abstraction Parameter Leaf Expression++ | Application Expression Expression+ | Operation Expression Leaf Expression+ | MemberCheck Expression Leaf [Selector]+ | Negation Leaf Expression+ | Inversion Leaf Expression+ deriving (Show)++data File+ = File Leaf Expression+ deriving (Show)++data Token+ = Integer Int+ | Float Double+ | Identifier Text+ | Path Text+ | EnvPath Text++ | KAssert+ | KElse+ | KIf+ | KIn+ | KInherit+ | KLet+ | KOr+ | KRec+ | KThen+ | KWith++ | TBraceOpen+ | TBraceClose+ | TBrackOpen+ | TBrackClose+ | TInterOpen+ | TInterClose+ | TParenOpen+ | TParenClose++ | TAssign+ | TAt+ | TColon+ | TComma+ | TDot+ | TDoubleQuote+ | TDoubleSingleQuote+ | TEllipsis+ | TQuestion+ | TSemicolon++ | TConcat+ | TNegate+ | TUpdate++ | TPlus+ | TMinus+ | TMul+ | TDiv++ | TAnd+ | TOr+ | TEqual+ | TGreater+ | TGreaterEqual+ | TImplies+ | TLess+ | TLessEqual+ | TNot+ | TUnequal++ | SOF+ deriving (Eq, Show)+++data Fixity+ = Prefix+ | InfixL+ | InfixN+ | InfixR+ | Postfix+ deriving (Show)++data Operator+ = Op Fixity Token+ | Apply+ deriving (Show)++-- | A list of lists of operators where lists that come first contain operators+-- that bind more strongly.+operators :: [[Operator]]+operators =+ [ [ Apply ]+ , [ Op Prefix TMinus ]+ , [ Op Postfix TQuestion ]+ , [ Op InfixR TConcat ]+ , [ Op InfixL TMul+ , Op InfixL TDiv ]+ , [ Op InfixL TPlus+ , Op InfixL TMinus ]+ , [ Op Prefix TNot ]+ , [ Op InfixR TUpdate ]+ , [ Op InfixN TLess+ , Op InfixN TGreater+ , Op InfixN TLessEqual+ , Op InfixN TGreaterEqual ]+ , [ Op InfixN TEqual+ , Op InfixN TUnequal ]+ , [ Op InfixL TAnd ]+ , [ Op InfixL TOr ]+ , [ Op InfixL TImplies ]+ ]++tokenText :: Token -> Text+tokenText (Identifier i) = i+tokenText (Integer i) = pack (show i)+tokenText (Float f) = pack (show f)+tokenText (Path p) = p+tokenText (EnvPath p) = "<" <> p <> ">"++tokenText KAssert = "assert"+tokenText KElse = "else"+tokenText KIf = "if"+tokenText KIn = "in"+tokenText KInherit = "inherit"+tokenText KLet = "let"+tokenText KOr = "or"+tokenText KRec = "rec"+tokenText KThen = "then"+tokenText KWith = "with"++tokenText TBraceOpen = "{"+tokenText TBraceClose = "}"+tokenText TBrackOpen = "["+tokenText TBrackClose = "]"+tokenText TInterOpen = "${"+tokenText TInterClose = "}"+tokenText TParenOpen = "("+tokenText TParenClose = ")"++tokenText TAssign = "="+tokenText TAt = "@"+tokenText TColon = ":"+tokenText TComma = ","+tokenText TDot = "."+tokenText TDoubleQuote = "\""+tokenText TDoubleSingleQuote = "''"+tokenText TEllipsis = "..."+tokenText TQuestion = "?"+tokenText TSemicolon = ";"++tokenText TPlus = "+"+tokenText TMinus = "-"+tokenText TMul = "*"+tokenText TDiv = "/"+tokenText TConcat = "++"+tokenText TNegate = "-"+tokenText TUpdate = "//"++tokenText TAnd = "&&"+tokenText TOr = "||"+tokenText TEqual = "=="+tokenText TGreater = ">"+tokenText TGreaterEqual = ">="+tokenText TImplies = "->"+tokenText TLess = "<"+tokenText TLessEqual = "<="+tokenText TNot = "!"+tokenText TUnequal = "!="++tokenText SOF = ""
+ src/Nixfmt/Util.hs view
@@ -0,0 +1,80 @@+{- © 2019 Serokell <hi@serokell.io>+ - © 2019 Lars Jellema <lars.jellema@gmail.com>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++module Nixfmt.Util+ ( manyP+ , someP+ , manyText+ , someText+ , commonPrefix+ , commonIndentation+ , dropCommonIndentation+ , identChar+ , pathChar+ , schemeChar+ , uriChar+ ) where++import Data.Char (isAlpha, isDigit, isSpace)+import Data.Maybe (fromMaybe)+import Data.Text as Text+ (Text, commonPrefixes, concat, empty, stripEnd, stripPrefix, takeWhile)+import Text.Megaparsec+ (ParsecT, Stream, Token, Tokens, many, some, takeWhile1P, takeWhileP)++charClass :: [Char] -> Char -> Bool+charClass s c = isAlpha c || isDigit c || elem c s++identChar :: Char -> Bool+identChar = charClass "_'-"++pathChar :: Char -> Bool+pathChar = charClass "._-+~"++schemeChar :: Char -> Bool+schemeChar = charClass "-.+"++uriChar :: Char -> Bool+uriChar = charClass "~!@$%&*-=_+:',./?"++-- | Match one or more characters that match a predicate.+someP :: (Stream s, Ord e) => (Token s -> Bool) -> ParsecT e s m (Tokens s)+someP = takeWhile1P Nothing++-- | Match zero or more characters that match a predicate.+manyP :: (Stream s, Ord e) => (Token s -> Bool) -> ParsecT e s m (Tokens s)+manyP = takeWhileP Nothing++-- | Match one or more texts and return the concatenation.+someText :: (Stream s, Ord e) => ParsecT e s m Text -> ParsecT e s m Text+someText p = Text.concat <$> some p++-- | Match zero or more texts and return the concatenation.+manyText :: (Stream s, Ord e) => ParsecT e s m Text -> ParsecT e s m Text+manyText p = Text.concat <$> many p++-- | The longest common prefix of the arguments.+commonPrefix :: Text -> Text -> Text+commonPrefix a b =+ case commonPrefixes a b of+ Nothing -> empty+ Just (prefix, _, _) -> prefix++-- | The longest common prefix consisting of only whitespace. The longest common+-- prefix of zero texts is infinite, represented as Nothing.+commonIndentation :: [Text] -> Maybe Text+commonIndentation [] = Nothing+commonIndentation [x] = Just $ Text.takeWhile isSpace x+commonIndentation (x:y:xs) = commonIndentation (commonPrefix x y : xs)++-- | Strip the longest common indentation from a list of lines. Empty lines do+-- not count towards the common indentation.+dropCommonIndentation :: [Text] -> [Text]+dropCommonIndentation unstrippedLines =+ let strippedLines = map stripEnd unstrippedLines+ in case commonIndentation (filter (/=empty) strippedLines) of+ Nothing -> map (const empty) strippedLines+ Just indentation -> map (fromMaybe empty . stripPrefix indentation) strippedLines