stylish-haskell 0.5.4.0 → 0.5.5.0
raw patch · 7 files changed
+96/−61 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- src/Language/Haskell/Stylish/Block.hs +13/−0
- src/Language/Haskell/Stylish/Config.hs +23/−18
- src/Language/Haskell/Stylish/Parse.hs +4/−12
- src/Language/Haskell/Stylish/Step/Imports.hs +1/−15
- src/Language/Haskell/Stylish/Step/LanguagePragmas.hs +32/−15
- stylish-haskell.cabal +1/−1
- tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +22/−0
src/Language/Haskell/Stylish/Block.hs view
@@ -10,6 +10,7 @@ , adjacent , merge , overlapping+ , groupAdjacent ) where @@ -76,3 +77,15 @@ any (uncurry overlapping') $ zip blocks (drop 1 blocks) where overlapping' (Block _ e1) (Block s2 _) = e1 >= s2+++--------------------------------------------------------------------------------+-- | Groups adjacent blocks into larger blocks+groupAdjacent :: [(Block a, b)]+ -> [(Block a, [b])]+groupAdjacent = foldr go []+ where+ -- This code is ugly and not optimal, and no fucks were given.+ go (b1, x) gs = case break (adjacent b1 . fst) gs of+ (_, []) -> (b1, [x]) : gs+ (ys, ((b2, xs) : zs)) -> (merge b1 b2, x : xs) : (ys ++ zs)
src/Language/Haskell/Stylish/Config.hs view
@@ -11,17 +11,18 @@ -------------------------------------------------------------------------------- import Control.Applicative (pure, (<$>), (<*>))-import Control.Monad (forM, msum, mzero)+import Control.Monad (forM, mzero) import Data.Aeson (FromJSON (..)) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import qualified Data.ByteString as B-import Data.List (intercalate)+import Data.List (inits, intercalate) import Data.Map (Map) import qualified Data.Map as M import Data.Yaml (decodeEither) import System.Directory-import System.FilePath ((</>))+import System.FilePath (joinPath, splitPath,+ (</>)) --------------------------------------------------------------------------------@@ -70,22 +71,26 @@ -------------------------------------------------------------------------------- configFilePath :: Verbose -> Maybe FilePath -> IO (Maybe FilePath)-configFilePath verbose userSpecified = do- (current, currentE) <- check $ (</> configFileName) <$> getCurrentDirectory- (home, homeE) <- check $ (</> configFileName) <$> getHomeDirectory- (def, defE) <- check defaultConfigFilePath- return $ msum- [ userSpecified- , if currentE then Just current else Nothing- , if homeE then Just home else Nothing- , if defE then Just def else Nothing- ]+configFilePath _ (Just userSpecified) = return $ Just userSpecified+configFilePath verbose Nothing = do+ current <- getCurrentDirectory+ home <- getHomeDirectory+ def <- defaultConfigFilePath+ search $+ [d </> configFileName | d <- ancestors current] +++ [home </> configFileName, def] where- check fp = do- fp' <- fp- ex <- doesFileExist fp'- verbose $ fp' ++ if ex then " exists" else " does not exist"- return (fp', ex)+ -- All ancestors of a dir (including that dir)+ ancestors :: FilePath -> [FilePath]+ ancestors = init . map joinPath . reverse . inits . splitPath++ search :: [FilePath] -> IO (Maybe FilePath)+ search [] = return Nothing+ search (f : fs) = do+ -- TODO Maybe catch an error here, dir might be unreadable+ exists <- doesFileExist f+ verbose $ f ++ if exists then " exists" else " does not exist"+ if exists then return (Just f) else search fs --------------------------------------------------------------------------------
src/Language/Haskell/Stylish/Parse.hs view
@@ -33,21 +33,13 @@ ----------------------------------------------------------------------------------- | Read an extension name from a string-parseExtension :: String -> Either String H.Extension-parseExtension str = case reads str of- [(x, "")] -> return x- _ -> throwError $ "Unknown extension: " ++ str----------------------------------------------------------------------------------- -- | Abstraction over HSE's parsing parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module parseModule extraExts mfp string = do- -- Determine the extensions: those specified in the file and the extra ones - extraExts' <- mapM parseExtension extraExts- let fileExts = fromMaybe [] $ H.readExtensions string- exts = fileExts ++ extraExts'+ -- Determine the extensions: those specified in the file and the extra ones+ let extraExts' = map H.classifyExtension extraExts+ fileExts = fromMaybe [] $ H.readExtensions string+ exts = fileExts ++ extraExts' -- Parsing options... fp = fromMaybe "<unknown>" mfp
src/Language/Haskell/Stylish/Step/Imports.hs view
@@ -47,20 +47,6 @@ ----------------------------------------------------------------------------------- | Groups adjacent imports into larger import blocks-groupAdjacent :: [H.ImportDecl LineBlock]- -> [(LineBlock, [H.ImportDecl LineBlock])]-groupAdjacent = foldr go []- where- -- This code is ugly and not optimal, and no fucks were given.- go imp is = case break (adjacent b1 . fst) is of- (_, []) -> (b1, [imp]) : is- (xs, ((b2, imps) : ys)) -> (merge b1 b2, imp : imps) : (xs ++ ys)- where- b1 = H.ann imp----------------------------------------------------------------------------------- -- | Compare imports for ordering compareImports :: H.ImportDecl l -> H.ImportDecl l -> Ordering compareImports = comparing (map toLower . importName &&& H.importQualified)@@ -179,7 +165,7 @@ where imps = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module' longest = longestImport imps- groups = groupAdjacent imps+ groups = groupAdjacent [(H.ann i, i) | i <- imps] fileAlign = case align of File -> any H.importQualified imps
src/Language/Haskell/Stylish/Step/LanguagePragmas.hs view
@@ -9,7 +9,7 @@ ---------------------------------------------------------------------------------import Data.List (nub, sort)+import qualified Data.Set as S import qualified Language.Haskell.Exts.Annotated as H @@ -41,13 +41,11 @@ ---------------------------------------------------------------------------------verticalPragmas :: [String] -> Lines-verticalPragmas pragmas' =+verticalPragmas :: Int -> [String] -> Lines+verticalPragmas longest pragmas' = [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}" | pragma <- pragmas' ]- where- longest = maximum $ map length pragmas' --------------------------------------------------------------------------------@@ -57,12 +55,29 @@ ---------------------------------------------------------------------------------prettyPragmas :: Int -> Style -> [String] -> Lines-prettyPragmas _ Vertical = verticalPragmas-prettyPragmas columns Compact = compactPragmas columns+prettyPragmas :: Int -> Int -> Style -> [String] -> Lines+prettyPragmas _ longest Vertical = verticalPragmas longest+prettyPragmas columns _ Compact = compactPragmas columns --------------------------------------------------------------------------------+-- | Filter redundant (and duplicate) pragmas out of the groups. As a side+-- effect, we also sort the pragmas in their group...+filterRedundant :: (String -> Bool)+ -> [(l, [String])]+ -> [(l, [String])]+filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, [])+ where+ filterRedundant' (l, xs) (known, zs)+ | S.null xs' = (known', zs)+ | otherwise = (known', (l, S.toAscList xs') : zs)+ where+ fxs = filter (not . isRedundant') xs+ xs' = S.fromList fxs `S.difference` known+ known' = xs' `S.union` known+++-------------------------------------------------------------------------------- step :: Int -> Style -> Bool -> Step step columns style = makeStep "LanguagePragmas" . step' columns style @@ -73,15 +88,17 @@ | null pragmas' = ls | otherwise = applyChanges changes ls where- filterRedundant- | removeRedundant = filter (not . isRedundant module')- | otherwise = id+ isRedundant'+ | removeRedundant = isRedundant module'+ | otherwise = const False pragmas' = pragmas $ fmap linesFromSrcSpan module'- uniques = filterRedundant $ nub $ sort $ snd =<< pragmas'- loc = firstLocation pragmas'- deletes = map (delete . fst) pragmas'- changes = insert loc (prettyPragmas columns style uniques) : deletes+ longest = maximum $ map length $ snd =<< pragmas'+ groups = [(b, concat pgs) | (b, pgs) <- groupAdjacent pragmas']+ changes =+ [ change b (const $ prettyPragmas columns longest style pg)+ | (b, pg) <- filterRedundant isRedundant' groups+ ] --------------------------------------------------------------------------------
stylish-haskell.cabal view
@@ -1,5 +1,5 @@ Name: stylish-haskell-Version: 0.5.4.0+Version: 0.5.5.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3
tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs view
@@ -22,6 +22,7 @@ , testCase "case 02" case02 , testCase "case 03" case03 , testCase "case 04" case04+ , testCase "case 05" case05 ] @@ -90,4 +91,25 @@ [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++ "TemplateHaskell," , " TypeOperators, ViewPatterns #-}"+ ]+++--------------------------------------------------------------------------------+case05 :: Assertion+case05 = expected @=? testStep (step 80 Vertical False) input+ where+ input = unlines+ [ "{-# LANGUAGE CPP #-}"+ , ""+ , "#if __GLASGOW_HASKELL__ >= 702"+ , "{-# LANGUAGE Trustworthy #-}"+ , "#endif"+ ]++ expected = unlines+ [ "{-# LANGUAGE CPP #-}"+ , ""+ , "#if __GLASGOW_HASKELL__ >= 702"+ , "{-# LANGUAGE Trustworthy #-}"+ , "#endif" ]