diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +## Ormolu 0.3.1.0 + +* Allow check mode when working with stdin input. [Issue 634]( + https://github.com/tweag/ormolu/issues/634). +* Now guards are printed on a new line if at least one guard is multiline or + if all guards together occupy more than one line. The body of each guard + is also indented one level deeper in that case. [Issue + 712](https://github.com/tweag/ormolu/issues/712). +* Invalid Haddock comments are no longer silently deleted, but rather converted + into regular comments. [Issue 474](https://github.com/tweag/ormolu/issues/474). + ## Ormolu 0.3.0.1 * Improvements to `.cabal` file handling: diff --git a/DESIGN.md b/DESIGN.md --- a/DESIGN.md +++ b/DESIGN.md @@ -113,7 +113,7 @@ Stylish Haskell is not so invasive as the other formatters and most reported bugs are about parsing issues and CPP. As I understand it, people mostly use -it to screw their import lists. +it to sort their import lists. ### Haskell formatter diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,8 +6,8 @@ [![Stackage LTS](http://stackage.org/package/ormolu/badge/lts)](http://stackage.org/lts/package/ormolu) [![Build status](https://badge.buildkite.com/8e3b0951f3652b77e1c422b361904136a539b0522029156354.svg?branch=master)](https://buildkite.com/tweag-1/ormolu) -* [Building and installation](#building-and-installation) - * [Arch Linux](#arch-linux) +* [Installation](#installation) +* [Building from source](#building-from-source) * [Usage](#usage) * [Editor integration](#editor-integration) * [GitHub actions](#github-actions) @@ -39,8 +39,26 @@ * Be well-tested and robust so that the formatter can be used in large projects. -## Building and installation +## Installation +The [release page][releases] has binaries for Linux, macOS and Windows. + +You can also install using `cabal` or `stack`: + +```console +$ cabal install ormolu +$ stack install ormolu +``` + +Ormolu is also included in several package repositories. E.g., on Arch Linux, +one can use [the package on AUR][aur]: + +```console +$ yay -S ormolu +``` + +## Building from source + The easiest way to build the project is with Nix: ```console @@ -73,14 +91,6 @@ in (import source { }).ormoluExe # this is e.g. the executable derivation ``` -### Arch Linux - -To install Ormolu on Arch Linux, one can use [the package on AUR][aur]: - -```console -yay -S ormolu -``` - ## Usage The following will print the formatted output to the standard output. @@ -114,6 +124,14 @@ $ ormolu --mode check $(find . -name '*.hs') ``` +#### :zap: Beware git's `core.autocrlf` on Windows :zap: +Ormolu's output always uses LF line endings. In particular, +`ormolu --mode check` will fail if its input is correctly formatted +*except* that it has CRLF line endings. This situation can happen on Windows +when checking out a git repository without having set [`core.autocrlf`]( +https://www.git-scm.com/docs/git-config#Documentation/git-config.txt-coreautocrlf) +to `false`. + ### Editor integration We know of the following editor integrations: @@ -174,7 +192,7 @@ 8 | Cabal file parsing failed 9 | Missing input file path when using stdin input and accounting for .cabal files 100 | In checking mode: unformatted files -101 | Inplace and check modes do not work with stdin +101 | Inplace mode does not work with stdin 102 | Other issue (with multiple input files) ## Limitations @@ -211,14 +229,15 @@ Copyright © 2018–present Tweag I/O -[iohk-hydra-binary-cache]: https://input-output-hk.github.io/haskell.nix/tutorials/getting-started/#setting-up-the-binary-cache [aur]: https://aur.archlinux.org/packages/ormolu [contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md [design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp [emacs-package]: https://github.com/vyorkin/ormolu.el [haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts +[iohk-hydra-binary-cache]: https://input-output-hk.github.io/haskell.nix/tutorials/getting-started/#setting-up-the-binary-cache [license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md [neoformat]: https://github.com/sbdchd/neoformat +[releases]: https://github.com/tweag/ormolu/releases [ormolu-action]: https://github.com/marketplace/actions/ormolu-action [vim-ormolu]: https://github.com/sdiehl/vim-ormolu [vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -11,6 +11,7 @@ import Data.Bool (bool) import Data.List (intercalate, sort) import Data.Maybe (mapMaybe) +import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Version (showVersion) import Development.GitRev @@ -66,54 +67,67 @@ formatOne CabalDefaultExtensionsOpts {..} mode config mpath = withPrettyOrmoluExceptions (cfgColorMode config) $ case FP.normalise <$> mpath of + -- input source = STDIN Nothing -> do - extraDynOptions <- - if optUseCabalDefaultExtensions - then case optStdinInputFile of - Just stdinInputFile -> - getCabalExtensionDynOptions stdinInputFile - Nothing -> throwIO OrmoluMissingStdinInputFile - else pure [] - r <- ormoluStdin (configPlus extraDynOptions) + resultConfig <- + configPlus + <$> if optUseCabalDefaultExtensions + then case optStdinInputFile of + Just stdinInputFile -> + getCabalExtensionDynOptions stdinInputFile + Nothing -> throwIO OrmoluMissingStdinInputFile + else pure [] case mode of Stdout -> do - TIO.putStr r + ormoluStdin resultConfig >>= TIO.putStr return ExitSuccess - _ -> do + InPlace -> do hPutStrLn stderr - "This feature is not supported when input comes from stdin." + "In place editing is not supported when input comes from stdin." -- 101 is different from all the other exit codes we already use. return (ExitFailure 101) + Check -> do + -- ormoluStdin is not used because we need the originalInput + originalInput <- getContentsUtf8 + let stdinRepr = "" + formattedInput <- + ormolu resultConfig stdinRepr (T.unpack originalInput) + handleDiff originalInput formattedInput stdinRepr + -- input source = a file Just inputFile -> do - extraDynOptions <- - if optUseCabalDefaultExtensions - then getCabalExtensionDynOptions inputFile - else pure [] - originalInput <- readFileUtf8 inputFile - formattedInput <- ormoluFile (configPlus extraDynOptions) inputFile + resultConfig <- + configPlus + <$> if optUseCabalDefaultExtensions + then getCabalExtensionDynOptions inputFile + else pure [] case mode of Stdout -> do - TIO.putStr formattedInput + ormoluFile resultConfig inputFile >>= TIO.putStr return ExitSuccess InPlace -> do - -- Only write when the contents have changed, in order to avoid - -- updating the modified timestamp if the file was already correctly - -- formatted. + -- ormoluFile is not used because we need originalInput + originalInput <- readFileUtf8 inputFile + formattedInput <- ormolu resultConfig inputFile (T.unpack originalInput) when (formattedInput /= originalInput) $ writeFileUtf8 inputFile formattedInput return ExitSuccess - Check -> - case diffText originalInput formattedInput inputFile of - Nothing -> return ExitSuccess - Just diff -> do - runTerm (printTextDiff diff) (cfgColorMode config) stderr - -- 100 is different to all the other exit code that are emitted - -- either from an 'OrmoluException' or from 'error' and - -- 'notImplemented'. - return (ExitFailure 100) + Check -> do + -- ormoluFile is not used because we need originalInput + originalInput <- readFileUtf8 inputFile + formattedInput <- ormolu resultConfig inputFile (T.unpack originalInput) + handleDiff originalInput formattedInput inputFile where configPlus dynOpts = config {cfgDynOptions = cfgDynOptions config ++ dynOpts} + handleDiff originalInput formattedInput fileRepr = + case diffText originalInput formattedInput fileRepr of + Nothing -> return ExitSuccess + Just diff -> do + runTerm (printTextDiff diff) (cfgColorMode config) stderr + -- 100 is different to all the other exit code that are emitted + -- either from an 'OrmoluException' or from 'error' and + -- 'notImplemented'. + return (ExitFailure 100) ---------------------------------------------------------------------------- -- Command line options parsing diff --git a/data/examples/declaration/value/function/multiple-guards.hs b/data/examples/declaration/value/function/multiple-guards.hs --- a/data/examples/declaration/value/function/multiple-guards.hs +++ b/data/examples/declaration/value/function/multiple-guards.hs @@ -1,7 +1,6 @@ foo :: Int -> Int -foo x - | x == 5 = 10 - | otherwise = 12 +foo x | x == 5 = 10 + | otherwise = 12 bar :: Int -> Int bar x diff --git a/data/examples/declaration/value/function/pattern/many-guards-in-singleline-out.hs b/data/examples/declaration/value/function/pattern/many-guards-in-singleline-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/value/function/pattern/many-guards-in-singleline-out.hs @@ -0,0 +1,3 @@ +foobar x | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7 + +foobaz | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7 diff --git a/data/examples/declaration/value/function/pattern/many-guards-in-singleline.hs b/data/examples/declaration/value/function/pattern/many-guards-in-singleline.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/value/function/pattern/many-guards-in-singleline.hs @@ -0,0 +1,3 @@ +foobar x | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7 + +foobaz | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7 diff --git a/data/examples/declaration/value/function/pattern/multiline-guard-statement-out.hs b/data/examples/declaration/value/function/pattern/multiline-guard-statement-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/value/function/pattern/multiline-guard-statement-out.hs @@ -0,0 +1,6 @@ +foobarbar :: Int -> Bool +foobarbar + | x <- + 5 = case x of + 5 -> True + _ -> False diff --git a/data/examples/declaration/value/function/pattern/multiline-guard-statement.hs b/data/examples/declaration/value/function/pattern/multiline-guard-statement.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/value/function/pattern/multiline-guard-statement.hs @@ -0,0 +1,5 @@ +foobarbar :: Int -> Bool +foobarbar | x <- + 5 = case x of + 5 -> True + _ -> False diff --git a/data/examples/declaration/value/function/pattern/multiple-guard-statements-out.hs b/data/examples/declaration/value/function/pattern/multiple-guard-statements-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/value/function/pattern/multiple-guard-statements-out.hs @@ -0,0 +1,6 @@ +foobarbar :: Int -> Bool +foobarbar + | x <- 5, + y <- 6 = case x of + 5 -> True + _ -> False diff --git a/data/examples/declaration/value/function/pattern/multiple-guard-statements.hs b/data/examples/declaration/value/function/pattern/multiple-guard-statements.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/value/function/pattern/multiple-guard-statements.hs @@ -0,0 +1,4 @@ +foobarbar :: Int -> Bool +foobarbar | x <- 5, y <- 6 = case x of + 5 -> True + _ -> False diff --git a/data/examples/other/invalid-haddock-out.hs b/data/examples/other/invalid-haddock-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/other/invalid-haddock-out.hs @@ -0,0 +1,17 @@ +test = undefined + where + a :: + -- foo + Int -> + -- misplaced + Int + a = undefined + +test = undefined + where + -- Comment + a = undefined + + -- A multiline + -- comment + b = b diff --git a/data/examples/other/invalid-haddock-weird-out.hs b/data/examples/other/invalid-haddock-weird-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/other/invalid-haddock-weird-out.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE TemplateHaskell #-} + +foo = foo -- # ${ diff --git a/data/examples/other/invalid-haddock-weird.hs b/data/examples/other/invalid-haddock-weird.hs new file mode 100644 --- /dev/null +++ b/data/examples/other/invalid-haddock-weird.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE TemplateHaskell #-} + +foo = foo -- |# ${ diff --git a/data/examples/other/invalid-haddock.hs b/data/examples/other/invalid-haddock.hs new file mode 100644 --- /dev/null +++ b/data/examples/other/invalid-haddock.hs @@ -0,0 +1,17 @@ +test = undefined + where + a :: + -- ** foo + Int -> + -- | misplaced + Int + a = undefined + +test = undefined + where + -- | Comment + a = undefined + + -- | A multiline + -- comment + b = b diff --git a/ormolu.cabal b/ormolu.cabal --- a/ormolu.cabal +++ b/ormolu.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: ormolu -version: 0.3.0.1 +version: 0.3.1.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov diff --git a/src/Ormolu.hs b/src/Ormolu.hs --- a/src/Ormolu.hs +++ b/src/Ormolu.hs @@ -97,9 +97,6 @@ -- | Load a file and format it. The file stays intact and the rendered -- version is returned as 'Text'. --- --- > ormoluFile cfg path = --- > liftIO (readFile path) >>= ormolu cfg path ormoluFile :: MonadIO m => -- | Ormolu configuration @@ -112,9 +109,6 @@ readFileUtf8 path >>= ormolu cfg path . T.unpack -- | Read input from stdin and format it. --- --- > ormoluStdin cfg = --- > liftIO (hGetContents stdin) >>= ormolu cfg "" ormoluStdin :: MonadIO m => -- | Ormolu configuration @@ -122,7 +116,7 @@ -- | Resulting rendition m Text ormoluStdin cfg = - liftIO getContents >>= ormolu cfg "" + getContentsUtf8 >>= ormolu cfg "" . T.unpack ---------------------------------------------------------------------------- -- Helpers diff --git a/src/Ormolu/Diff/ParseResult.hs b/src/Ormolu/Diff/ParseResult.hs --- a/src/Ormolu/Diff/ParseResult.hs +++ b/src/Ormolu/Diff/ParseResult.hs @@ -16,6 +16,7 @@ where import Data.ByteString (ByteString) +import Data.Foldable import Data.Generics import GHC.Hs import GHC.Types.Basic @@ -54,11 +55,18 @@ { prCommentStream = cstream1, prParsedSource = hs1 } = - matchIgnoringSrcSpans cstream0 cstream1 + diffCommentStream cstream0 cstream1 <> matchIgnoringSrcSpans hs0 {hsmodImports = normalizeImports (hsmodImports hs0)} hs1 {hsmodImports = normalizeImports (hsmodImports hs1)} +diffCommentStream :: CommentStream -> CommentStream -> ParseResultDiff +diffCommentStream (CommentStream cs) (CommentStream cs') + | commentLines cs == commentLines cs' = Same + | otherwise = Different [] + where + commentLines = concatMap (toList . unComment . unLoc) + -- | Compare two values for equality disregarding the following aspects: -- -- * 'SrcSpan's @@ -83,7 +91,6 @@ gzipWithQ ( genericQuery `extQ` srcSpanEq - `extQ` commentEq `extQ` sourceTextEq `extQ` hsDocStringEq `extQ` importDeclQualifiedStyleEq @@ -96,14 +103,6 @@ | otherwise = Different [] srcSpanEq :: SrcSpan -> GenericQ ParseResultDiff srcSpanEq _ _ = Same - commentEq :: Comment -> GenericQ ParseResultDiff - commentEq (Comment _ x) d = - case cast d :: Maybe Comment of - Nothing -> Different [] - Just (Comment _ y) -> - if x == y - then Same - else Different [] sourceTextEq :: SourceText -> GenericQ ParseResultDiff sourceTextEq _ _ = Same importDeclQualifiedStyleEq :: diff --git a/src/Ormolu/Parser.hs b/src/Ormolu/Parser.hs --- a/src/Ormolu/Parser.hs +++ b/src/Ormolu/Parser.hs @@ -116,7 +116,7 @@ Just err -> Left err Nothing -> let (stackHeader, pragmas, comments) = - mkCommentStream input pstate + mkCommentStream input pstate hsModule in Right ParseResult { prParsedSource = hsModule, diff --git a/src/Ormolu/Parser/CommentStream.hs b/src/Ormolu/Parser/CommentStream.hs --- a/src/Ormolu/Parser/CommentStream.hs +++ b/src/Ormolu/Parser/CommentStream.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} -- | Functions for working with comment stream. module Ormolu.Parser.CommentStream @@ -19,15 +20,23 @@ import Data.Char (isSpace) import Data.Data (Data) +import Data.Generics.Schemes import qualified Data.List as L import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE -import Data.Maybe (mapMaybe) +import qualified Data.Map.Lazy as M +import Data.Maybe +import qualified Data.Set as S +import GHC.Hs (HsModule) +import GHC.Hs.Decls (HsDecl (..), LDocDecl, LHsDecl) +import GHC.Hs.Doc +import GHC.Hs.Extension +import GHC.Hs.ImpExp import qualified GHC.Parser.Annotation as GHC import qualified GHC.Parser.Lexer as GHC import GHC.Types.SrcLoc import Ormolu.Parser.Pragma -import Ormolu.Utils (onTheSameLine, showOutputable) +import Ormolu.Utils (onTheSameLine, showOutputable, unSrcSpan) ---------------------------------------------------------------------------- -- Comment stream @@ -44,12 +53,14 @@ String -> -- | Parser state to use for comment extraction GHC.PState -> + -- | Parsed module + HsModule -> -- | Stack header, pragmas, and comment stream ( Maybe (RealLocated Comment), [([RealLocated Comment], Pragma)], CommentStream ) -mkCommentStream input pstate = +mkCommentStream input pstate hsModule = ( mstackHeader, pragmas, CommentStream comments @@ -57,12 +68,46 @@ where (comments, pragmas) = extractPragmas input rawComments1 (rawComments1, mstackHeader) = extractStackHeader rawComments0 + + -- We want to extract all comments except _valid_ Haddock comments rawComments0 = - L.sortOn (realSrcSpanStart . getRealSrcSpan) $ - mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate) - ++ concatMap - (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd) - (GHC.annotations_comments pstate) + fmap (uncurry L) + . M.toAscList + . flip M.withoutKeys validHaddockCommentSpans + . M.fromList + . fmap (\(L l a) -> (l, a)) + $ allComments + where + -- All comments, including valid and invalid Haddock comments + allComments = + fmap (fmap unAnnotationComment) + . (GHC.comment_q <> (concatMap snd . GHC.annotations_comments)) + $ pstate + -- All spans of valid Haddock comments + -- (everywhere where we use p_hsDoc{String,Name}) + validHaddockCommentSpans = + S.fromList + . mapMaybe unSrcSpan + . mconcat + [ fmap getLoc . listify (only @LHsDocString), + fmap getLoc . listify (only @LDocDecl), + fmap getLoc . listify isDocD, + fmap getLoc . listify isIEDocLike + ] + $ hsModule + where + only :: a -> Bool + only _ = True + isDocD :: LHsDecl GhcPs -> Bool + isDocD = \case + L _ DocD {} -> True + _ -> False + isIEDocLike :: LIE GhcPs -> Bool + isIEDocLike = \case + L _ IEGroup {} -> True + L _ IEDoc {} -> True + L _ IEDocNamed {} -> True + _ -> False -- | Pretty-print a 'CommentStream'. showCommentStream :: CommentStream -> String @@ -96,17 +141,16 @@ where comment = L l . Comment atomsBefore . removeConseqBlanks . fmap dropTrailing $ - if "{-" `L.isPrefixOf` s - then case NE.nonEmpty (lines s) of - Nothing -> s :| [] - Just (x :| xs) -> - let getIndent y = - if all isSpace y - then startIndent - else length (takeWhile isSpace y) - n = minimum (startIndent : fmap getIndent xs) - in x :| (drop n <$> xs) - else s :| [] + case NE.nonEmpty (lines s) of + Nothing -> s :| [] + Just (x :| xs) -> + let getIndent y = + if all isSpace y + then startIndent + else length (takeWhile isSpace y) + n = minimum (startIndent : fmap getIndent xs) + commentPrefix = if "{-" `L.isPrefixOf` s then "" else "-- " + in x :| ((commentPrefix <>) . drop n <$> xs) (atomsBefore, ls') = case dropWhile ((< commentLine) . fst) ls of [] -> (False, []) @@ -182,20 +226,21 @@ else go' ls [] xs -- | Get a 'String' from 'GHC.AnnotationComment'. -unAnnotationComment :: GHC.AnnotationComment -> Maybe String +unAnnotationComment :: GHC.AnnotationComment -> String unAnnotationComment = \case - GHC.AnnDocCommentNext _ -> Nothing -- @-- |@ - GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@ - GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@ - GHC.AnnDocSection _ _ -> Nothing -- @-- *@ - GHC.AnnDocOptions s -> Just s - GHC.AnnLineComment s -> Just s - GHC.AnnBlockComment s -> Just s - -liftMaybe :: GenLocated l (Maybe a) -> Maybe (GenLocated l a) -liftMaybe = \case - L _ Nothing -> Nothing - L l (Just a) -> Just (L l a) + GHC.AnnDocCommentNext s -> dashPrefix s -- @-- |@ + GHC.AnnDocCommentPrev s -> dashPrefix s -- @-- ^@ + GHC.AnnDocCommentNamed s -> dashPrefix s -- @-- $@ + GHC.AnnDocSection _ s -> dashPrefix s -- @-- *@ + GHC.AnnDocOptions s -> s + GHC.AnnLineComment s -> s + GHC.AnnBlockComment s -> s + where + dashPrefix s = "--" <> spaceIfNecessary <> s + where + spaceIfNecessary = case s of + c : _ | c /= ' ' -> " " + _ -> "" -- | Remove consecutive blank lines. removeConseqBlanks :: NonEmpty String -> NonEmpty String diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -248,17 +248,22 @@ endOfPats placement = case endOfPats of - Nothing -> blockPlacement placer grhssGRHSs - Just spn -> - if onTheSameLine spn grhssSpan - then blockPlacement placer grhssGRHSs - else Normal + Just spn + | any guardNeedsLineBreak grhssGRHSs + || not (onTheSameLine spn grhssSpan) -> + Normal + _ -> blockPlacement placer grhssGRHSs + guardNeedsLineBreak :: Located (GRHS GhcPs body) -> Bool + guardNeedsLineBreak (L _ (GRHS _ guardLStmts _)) = case guardLStmts of + [] -> False + [L l _] -> not (isOneLineSpan l) + _ -> True p_body = do let groupStyle = if isCase style && hasGuards then RightArrow else EqualSign - sep newline (located' (p_grhs' placer render groupStyle)) grhssGRHSs + sep breakpoint (located' (p_grhs' placer render groupStyle)) grhssGRHSs p_where = do let whereIsEmpty = eqEmptyLocalBinds (unLoc grhssLocalBinds) unless (eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do diff --git a/src/Ormolu/Utils/IO.hs b/src/Ormolu/Utils/IO.hs --- a/src/Ormolu/Utils/IO.hs +++ b/src/Ormolu/Utils/IO.hs @@ -3,11 +3,13 @@ module Ormolu.Utils.IO ( writeFileUtf8, readFileUtf8, + getContentsUtf8, ) where import Control.Exception (throwIO) import Control.Monad.IO.Class +import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Text (Text) import qualified Data.Text.Encoding as TE @@ -20,4 +22,13 @@ -- | Read an entire file strictly into a 'Text' using UTF8 and -- ignoring native line ending conventions. readFileUtf8 :: MonadIO m => FilePath -> m Text -readFileUtf8 p = liftIO $ either throwIO pure . TE.decodeUtf8' =<< B.readFile p +readFileUtf8 p = liftIO (B.readFile p) >>= decodeUtf8 + +-- | Read stdin as UTF8-encoded 'Text' value. +getContentsUtf8 :: MonadIO m => m Text +getContentsUtf8 = liftIO B.getContents >>= decodeUtf8 + +-- | A helper function for decoding a strict 'ByteString' into 'Text'. It is +-- strict and fails immediately if decoding encounters a problem. +decodeUtf8 :: MonadIO m => ByteString -> m Text +decodeUtf8 = liftIO . either throwIO pure . TE.decodeUtf8'