stylish-haskell 0.5.17.0 → 0.6.0.0
raw patch · 17 files changed
+553/−182 lines, 17 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Language.Haskell.Stylish: records :: Step
+ Language.Haskell.Stylish: [configNewline] :: Config -> Newline
+ Language.Haskell.Stylish: simpleAlign :: Int -> Config -> Step
- Language.Haskell.Stylish: Config :: [Step] -> Int -> [String] -> Config
+ Language.Haskell.Stylish: Config :: [Step] -> Int -> [String] -> Newline -> Config
Files
- CHANGELOG +10/−0
- data/stylish-haskell.yaml +20/−3
- lib/Language/Haskell/Stylish.hs +9/−7
- lib/Language/Haskell/Stylish/Align.hs +97/−0
- lib/Language/Haskell/Stylish/Block.hs +8/−3
- lib/Language/Haskell/Stylish/Config.hs +25/−7
- lib/Language/Haskell/Stylish/Editor.hs +8/−1
- lib/Language/Haskell/Stylish/Parse.hs +19/−2
- lib/Language/Haskell/Stylish/Step/Records.hs +0/−79
- lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +109/−0
- lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +4/−0
- src/Main.hs +31/−12
- stylish-haskell.cabal +18/−3
- tests/Language/Haskell/Stylish/Parse/Tests.hs +42/−6
- tests/Language/Haskell/Stylish/Step/Records/Tests.hs +0/−56
- tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs +150/−0
- tests/TestSuite.hs +3/−3
CHANGELOG view
@@ -1,3 +1,13 @@+# CHANGELOG++- 0.6.0.0+ * Add a `simple_align` step+ * Move `records` step into `simple_align`+ * Use a set of default language extensions for parsing (by Langston Barrett)+ * Add a newline format option (by Svyatolslav Gryaznov)+ * Add more symbols from UnicodeSyntax (by Langston Barrett)+ * Add a `--version` option (by Ondra Pelech)+ - 0.5.17.0 * Remove shebang from input before attempting to extract pragmas * Set stdin and stdout encoding to UTF-8 by default
data/stylish-haskell.yaml view
@@ -15,6 +15,14 @@ # # true. # add_language_pragma: true + # Align the right hand side of some elements. This is quite conservative+ # and only applies to statements where each element occupies a single+ # line.+ - simple_align:+ cases: true+ top_level_patterns: true+ records: true+ # Import cleanup - imports: # There are different ways we can align names and lists.@@ -128,9 +136,6 @@ # is set to true, it will remove those redundant pragmas. Default: true. remove_redundant: true - # Align the types in record declarations- - records: {}- # Replace tabs by spaces. This is disabled by default. # - tabs: # # Number of spaces to use for each tab. Default: 8, as specified by the@@ -143,6 +148,18 @@ # A common setting is the number of columns (parts of) code will be wrapped # to. Different steps take this into account. Default: 80. columns: 80++# By default, line endings are converted according to the OS. You can override+# preferred format here.+#+# - native: Native newline format. CRLF on Windows, LF on other OSes.+#+# - lf: Convert to LF ("\n").+#+# - crlf: Convert to CRLF ("\r\n").+#+# Default: native.+newline: native # Sometimes, language extensions are specified in a cabal file or from the # command line instead of using language pragmas in the file. stylish-haskell
lib/Language/Haskell/Stylish.hs view
@@ -3,9 +3,9 @@ ( -- * Run runSteps -- * Steps+ , simpleAlign , imports , languagePragmas- , records , tabs , trailingWhitespace , unicodeSyntax@@ -34,7 +34,7 @@ import Language.Haskell.Stylish.Step import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas-import qualified Language.Haskell.Stylish.Step.Records as Records+import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign import qualified Language.Haskell.Stylish.Step.Tabs as Tabs import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax@@ -43,6 +43,13 @@ --------------------------------------------------------------------------------+simpleAlign :: Int -- ^ Columns+ -> SimpleAlign.Config+ -> Step+simpleAlign = SimpleAlign.step+++-------------------------------------------------------------------------------- imports :: Int -- ^ columns -> Imports.Align -> Step@@ -56,11 +63,6 @@ -> Bool -- ^ remove redundant? -> Step languagePragmas = LanguagePragmas.step------------------------------------------------------------------------------------records :: Step-records = Records.step --------------------------------------------------------------------------------
+ lib/Language/Haskell/Stylish/Align.hs view
@@ -0,0 +1,97 @@+--------------------------------------------------------------------------------+-- | This module is useful for aligning things.+module Language.Haskell.Stylish.Align+ ( Alignable (..)+ , align+ ) where+++--------------------------------------------------------------------------------+import Data.Char (isSpace)+import Data.List (nub)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import Language.Haskell.Stylish.Editor+import Language.Haskell.Stylish.Util+++--------------------------------------------------------------------------------+-- | This represent a single line which can be aligned. We have something on+-- the left and the right side, e.g.:+--+-- > [x] -> x + 1+-- > ^^^^ ^^^^^+-- > LEFT RIGHT+--+-- We also have the container which holds the entire line:+--+-- > [x] -> x + 1+-- > ^^^^^^^^^^^^^+-- > CONTAINER+--+-- And then we have a "right lead" which is just represented by an 'Int', since+-- @haskell-src-exts@ often does not allow us to access it. In the example this+-- is:+--+-- > [x] -> x + 1+-- > ^^^+-- > RLEAD+--+-- This info is enough to align a bunch of these lines. Users of this module+-- should construct a list of 'Alignable's representing whatever they want to+-- align, and then call 'align' on that.+data Alignable a = Alignable+ { aContainer :: !a+ , aLeft :: !a+ , aRight :: !a+ -- | This is the minimal number of columns we need for the leading part not+ -- included in our right string. For example, for datatype alignment, this+ -- leading part is the string ":: " so we use 3.+ , aRightLead :: !Int+ } deriving (Show)+++--------------------------------------------------------------------------------+-- | Create changes that perform the alignment.+align+ :: Int -- ^ Max columns+ -> [Alignable H.SrcSpan] -- ^ Alignables+ -> [Change String] -- ^ Changes performing the alignment.+align maxColumns alignment+ -- Do not make any change if we would go past the maximum number of columns.+ | longestLeft + longestRight > maxColumns = []+ | not (fixable alignment) = []+ | otherwise = map align' alignment+ where+ -- The longest thing in the left column.+ longestLeft = maximum $ map (H.srcSpanEndColumn . aLeft) alignment++ -- The longest thing in the right column.+ longestRight = maximum+ [ H.srcSpanEndColumn (aRight a) - H.srcSpanStartColumn (aRight a)+ + aRightLead a+ | a <- alignment+ ]++ align' a = changeLine (H.srcSpanStartLine $ aContainer a) $ \str ->+ let column = H.srcSpanEndColumn $ aLeft a+ (pre, post) = splitAt column str+ in [padRight longestLeft (trimRight pre) ++ trimLeft post]++ trimLeft = dropWhile isSpace+ trimRight = reverse . trimLeft . reverse+++--------------------------------------------------------------------------------+-- | Checks that all the alignables appear on a single line, and that they do+-- not overlap.+fixable :: [Alignable H.SrcSpan] -> Bool+fixable [] = False+fixable [_] = False+fixable fields = all singleLine containers && nonOverlapping containers+ where+ containers = map aContainer fields+ singleLine s = H.srcSpanStartLine s == H.srcSpanEndLine s+ nonOverlapping ss = length ss == length (nub $ map H.srcSpanStartLine ss)
lib/Language/Haskell/Stylish/Block.hs view
@@ -16,6 +16,7 @@ -------------------------------------------------------------------------------- import Control.Arrow (arr, (&&&), (>>>))+import qualified Data.IntSet as IS import qualified Language.Haskell.Exts.Annotated as H @@ -73,10 +74,14 @@ -------------------------------------------------------------------------------- overlapping :: [Block a] -> Bool-overlapping blocks =- any (uncurry overlapping') $ zip blocks (drop 1 blocks)+overlapping = go IS.empty where- overlapping' (Block _ e1) (Block s2 _) = e1 >= s2+ go _ [] = False+ go acc (b : bs) =+ let ints = [blockStart b .. blockEnd b] in+ if any (`IS.member` acc) ints+ then True+ else go (IS.union acc $ IS.fromList ints) bs --------------------------------------------------------------------------------
lib/Language/Haskell/Stylish/Config.hs view
@@ -14,6 +14,7 @@ import Data.Aeson (FromJSON (..)) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A+import Data.Maybe (fromMaybe) import qualified Data.ByteString as B import Data.List (inits, intercalate)@@ -24,13 +25,15 @@ import System.FilePath (joinPath, splitPath, (</>))+import qualified System.IO as IO (Newline (..),+ nativeNewline) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Step import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas-import qualified Language.Haskell.Stylish.Step.Records as Records+import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign import qualified Language.Haskell.Stylish.Step.Tabs as Tabs import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax@@ -47,6 +50,7 @@ { configSteps :: [Step] , configColumns :: Int , configLanguageExtensions :: [String]+ , configNewline :: IO.Newline } @@ -115,11 +119,18 @@ <$> pure [] <*> (o A..:? "columns" A..!= 80) <*> (o A..:? "language_extensions" A..!= [])+ <*> (o A..:? "newline" >>= parseEnum newlines IO.nativeNewline) -- Then fill in the steps based on the partial config we already have stepValues <- o A..: "steps" :: A.Parser [A.Value] steps <- mapM (parseSteps config) stepValues return config {configSteps = concat steps}+ where+ newlines =+ [ ("native", IO.nativeNewline)+ , ("lf", IO.LF)+ , ("crlf", IO.CRLF)+ ] parseConfig _ = mzero @@ -128,7 +139,7 @@ catalog = M.fromList [ ("imports", parseImports) , ("language_pragmas", parseLanguagePragmas)- , ("records", parseRecords)+ , ("simple_align", parseSimpleAlign) , ("tabs", parseTabs) , ("trailing_whitespace", parseTrailingWhitespace) , ("unicode_syntax", parseUnicodeSyntax)@@ -155,6 +166,18 @@ --------------------------------------------------------------------------------+parseSimpleAlign :: Config -> A.Object -> A.Parser Step+parseSimpleAlign c o = SimpleAlign.step+ <$> pure (configColumns c)+ <*> (SimpleAlign.Config+ <$> withDef SimpleAlign.cCases "cases"+ <*> withDef SimpleAlign.cTopLevelPatterns "top_level_patterns"+ <*> withDef SimpleAlign.cRecords "records")+ where+ withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k)+++-------------------------------------------------------------------------------- parseImports :: Config -> A.Object -> A.Parser Step parseImports config o = Imports.step <$> pure (configColumns config)@@ -201,11 +224,6 @@ , ("compact", LanguagePragmas.Compact) , ("compact_line", LanguagePragmas.CompactLine) ]------------------------------------------------------------------------------------parseRecords :: Config -> A.Object -> A.Parser Step-parseRecords _ _ = return Records.step --------------------------------------------------------------------------------
lib/Language/Haskell/Stylish/Editor.hs view
@@ -19,6 +19,10 @@ --------------------------------------------------------------------------------+import Data.List (intercalate)+++-------------------------------------------------------------------------------- import Language.Haskell.Stylish.Block @@ -40,10 +44,13 @@ applyChanges changes | overlapping blocks = error $ "Language.Haskell.Stylish.Editor.applyChanges: " ++- "refusing to make overlapping changes"+ "refusing to make overlapping changes on lines " +++ intercalate ", " (map printBlock blocks) | otherwise = go 1 changes where blocks = map changeBlock changes++ printBlock b = show (blockStart b) ++ "-" ++ show (blockEnd b) go _ [] ls = ls go n (ch : chs) ls =
lib/Language/Haskell/Stylish/Parse.hs view
@@ -7,13 +7,30 @@ -------------------------------------------------------------------------------- import Data.Maybe (fromMaybe, listToMaybe) import qualified Language.Haskell.Exts.Annotated as H-import Data.List (isPrefixOf)+import Data.List (isPrefixOf, nub) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Config import Language.Haskell.Stylish.Step +--------------------------------------------------------------------------------+-- | Syntax-related language extensions are always enabled for parsing. Since we+-- can't authoritatively know which extensions are enabled at compile-time, we+-- should try not to throw errors when parsing any GHC-accepted code.+defaultExtensions :: [H.Extension]+defaultExtensions = map H.EnableExtension+ [ H.GADTs+ , H.HereDocuments+ , H.KindSignatures+ , H.MagicHash+ , H.NewQualifiedOperators+ , H.PatternGuards+ , H.StandaloneDeriving+ , H.UnicodeSyntax+ , H.XmlSyntax+ ] + -------------------------------------------------------------------------------- -- | Filter out lines which use CPP macros unCpp :: String -> String@@ -50,7 +67,7 @@ let noPrefixes = unShebang . dropBom $ string extraExts' = map H.classifyExtension extraExts (lang, fileExts) = fromMaybe (Nothing, []) $ H.readExtensions noPrefixes- exts = fileExts ++ extraExts'+ exts = nub $ fileExts ++ extraExts' ++ defaultExtensions -- Parsing options... fp = fromMaybe "<unknown>" mfp
− lib/Language/Haskell/Stylish/Step/Records.hs
@@ -1,79 +0,0 @@----------------------------------------------------------------------------------module Language.Haskell.Stylish.Step.Records- ( step- ) where------------------------------------------------------------------------------------import Data.Char (isSpace)-import Data.List (nub)-import qualified Language.Haskell.Exts.Annotated as H------------------------------------------------------------------------------------import Language.Haskell.Stylish.Editor-import Language.Haskell.Stylish.Step-import Language.Haskell.Stylish.Util------------------------------------------------------------------------------------records :: H.Module l -> [[Alignable l]]-records modu =- [ map fieldDeclToAlignable fields- | H.Module _ _ _ _ decls <- [modu]- , H.DataDecl _ _ _ _ cons _ <- decls- , H.QualConDecl _ _ _ (H.RecDecl _ _ fields) <- cons- ]------------------------------------------------------------------------------------data Alignable a = Alignable- { aContainer :: !a- , aLeft :: !a- , aRight :: !a- } deriving (Show)------------------------------------------------------------------------------------fieldDeclToAlignable :: H.FieldDecl a -> Alignable a-fieldDeclToAlignable (H.FieldDecl ann names ty) = Alignable- { aContainer = ann- , aLeft = H.ann (last names)- , aRight = H.ann ty- }-------------------------------------------------------------------------------------- | Align the type of a field-align :: [Alignable H.SrcSpan] -> [Change String]-align alignment = map align' alignment- where- longest = maximum $ map (H.srcSpanEndColumn . aLeft) alignment-- align' a = changeLine (H.srcSpanStartLine $ aContainer a) $ \str ->- let column = H.srcSpanEndColumn $ aLeft a- (pre, post) = splitAt column str- in [padRight longest (trimRight pre) ++ trimLeft post]-- trimLeft = dropWhile isSpace- trimRight = reverse . trimLeft . reverse-------------------------------------------------------------------------------------- | Checks that all no field of the record appears on more than one line,--- amonst other things-fixable :: [Alignable H.SrcSpan] -> Bool-fixable [] = False-fixable fields = all singleLine containers && nonOverlapping containers- where- containers = map aContainer fields- singleLine s = H.srcSpanStartLine s == H.srcSpanEndLine s- nonOverlapping ss = length ss == length (nub $ map H.srcSpanStartLine ss)------------------------------------------------------------------------------------step :: Step-step = makeStep "Records" $ \ls (module', _) ->- let module'' = fmap H.srcInfoSpan module'- fixableRecords = filter fixable $ records module''- in applyChanges (fixableRecords >>= align) ls
+ lib/Language/Haskell/Stylish/Step/SimpleAlign.hs view
@@ -0,0 +1,109 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.SimpleAlign+ ( Config (..)+ , defaultConfig+ , step+ ) where+++--------------------------------------------------------------------------------+import Data.Data (Data)+import Data.Maybe (maybeToList)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import Language.Haskell.Stylish.Align+import Language.Haskell.Stylish.Editor+import Language.Haskell.Stylish.Step+import Language.Haskell.Stylish.Util+++--------------------------------------------------------------------------------+data Config = Config+ { cCases :: !Bool+ , cTopLevelPatterns :: !Bool+ , cRecords :: !Bool+ } deriving (Show)+++--------------------------------------------------------------------------------+defaultConfig :: Config+defaultConfig = Config+ { cCases = True+ , cTopLevelPatterns = True+ , cRecords = True+ }+++--------------------------------------------------------------------------------+cases :: Data l => H.Module l -> [[H.Alt l]]+cases modu = [alts | H.Case _ _ alts <- everything modu]+++--------------------------------------------------------------------------------+altToAlignable :: H.Alt l -> Maybe (Alignable l)+altToAlignable (H.Alt _ _ _ (Just _)) = Nothing+altToAlignable (H.Alt ann pat rhs Nothing) = Just $ Alignable+ { aContainer = ann+ , aLeft = H.ann pat+ , aRight = H.ann rhs+ , aRightLead = length "-> "+ }+++--------------------------------------------------------------------------------+tlpats :: Data l => H.Module l -> [[H.Match l]]+tlpats modu = [matches | H.FunBind _ matches <- everything modu]+++--------------------------------------------------------------------------------+matchToAlignable :: H.Match l -> Maybe (Alignable l)+matchToAlignable (H.InfixMatch _ _ _ _ _ _) = Nothing+matchToAlignable (H.Match _ _ [] _ _) = Nothing+matchToAlignable (H.Match _ _ _ _ (Just _)) = Nothing+matchToAlignable (H.Match ann name pats rhs Nothing) = Just $ Alignable+ { aContainer = ann+ , aLeft = last (H.ann name : map H.ann pats)+ , aRight = H.ann rhs+ , aRightLead = length "= "+ }+++--------------------------------------------------------------------------------+records :: H.Module l -> [[H.FieldDecl l]]+records modu =+ [ fields+ | H.Module _ _ _ _ decls <- [modu]+ , H.DataDecl _ _ _ _ cons _ <- decls+ , H.QualConDecl _ _ _ (H.RecDecl _ _ fields) <- cons+ ]+++--------------------------------------------------------------------------------+fieldDeclToAlignable :: H.FieldDecl a -> Maybe (Alignable a)+fieldDeclToAlignable (H.FieldDecl ann names ty) = Just $ Alignable+ { aContainer = ann+ , aLeft = H.ann (last names)+ , aRight = H.ann ty+ , aRightLead = length ":: "+ }+++--------------------------------------------------------------------------------+step :: Int -> Config -> Step+step maxColumns config = makeStep "Cases" $ \ls (module', _) ->+ let module'' = fmap H.srcInfoSpan module'+ changes search toAlign =+ [ change_+ | case_ <- search module''+ , aligns <- maybeToList (mapM toAlign case_)+ , change_ <- align maxColumns aligns+ ]++ configured = concat $+ [changes cases altToAlignable | cCases config] +++ [changes tlpats matchToAlignable | cTopLevelPatterns config] +++ [changes records fieldDeclToAlignable | cRecords config]++ in applyChanges configured ls
lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs view
@@ -26,6 +26,10 @@ [ ("::", "∷") , ("=>", "⇒") , ("->", "→")+ , ("<-", "←")+ , ("forall", "∀")+ , ("-<", "↢")+ , (">-", "↣") ]
src/Main.hs view
@@ -1,5 +1,4 @@ ---------------------------------------------------------------------------------{-# LANGUAGE DeriveDataTypeable #-} module Main ( main ) where@@ -21,7 +20,8 @@ -------------------------------------------------------------------------------- data StylishArgs = StylishArgs- { saConfig :: Maybe FilePath+ { saVersion :: Bool+ , saConfig :: Maybe FilePath , saVerbose :: Bool , saDefaults :: Bool , saInPlace :: Bool@@ -33,7 +33,11 @@ -------------------------------------------------------------------------------- parseStylishArgs :: OA.Parser StylishArgs parseStylishArgs = StylishArgs- <$> OA.optional (OA.strOption $+ <$> OA.switch (+ OA.help "Show version information" <>+ OA.long "version" <>+ OA.hidden)+ <*> OA.optional (OA.strOption $ OA.metavar "CONFIG" <> OA.help "Configuration file" <> OA.long "config" <>@@ -64,10 +68,15 @@ --------------------------------------------------------------------------------+stylishHaskellVersion :: String+stylishHaskellVersion = "stylish-haskell " <> showVersion Paths_stylish_haskell.version+++-------------------------------------------------------------------------------- parserInfo :: OA.ParserInfo StylishArgs parserInfo = OA.info (OA.helper <*> parseStylishArgs) $ OA.fullDesc <>- OA.header ("stylish-haskell v" <> showVersion Paths_stylish_haskell.version)+ OA.header stylishHaskellVersion --------------------------------------------------------------------------------@@ -80,12 +89,15 @@ stylishHaskell sa = do unless (saNoUtf8 sa) $ mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout]- case saDefaults sa of- True -> do+ if saVersion sa then+ putStrLn stylishHaskellVersion++ else if saDefaults sa then do fileName <- defaultConfigFilePath verbose' $ "Dumping config from " ++ fileName readUTF8File fileName >>= putStr- False -> do++ else do conf <- loadConfig verbose' (saConfig sa) let steps = configSteps conf forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step"@@ -109,14 +121,21 @@ Right ok -> write contents $ unlines ok where write old new = case mfp of- Nothing -> putStr new- Just _ | not (saInPlace sa) -> putStr new- Just path | length new /= 0 && old /= new -> writeFile path new+ Nothing -> putStrNewline new+ Just _ | not (saInPlace sa) -> putStrNewline new+ Just path | not (null new) && old /= new ->+ IO.withFile path IO.WriteMode $ \h -> do+ setNewlineMode h+ IO.hPutStr h new _ -> return ()+ setNewlineMode h = do+ let nl = configNewline conf+ let mode = IO.NewlineMode IO.nativeNewline nl+ IO.hSetNewlineMode h mode+ putStrNewline txt = setNewlineMode IO.stdout >> putStr txt readUTF8File :: FilePath -> IO String readUTF8File fp = IO.withFile fp IO.ReadMode $ \h -> do IO.hSetEncoding h IO.utf8- content <- IO.Strict.hGetContents h- return content+ IO.Strict.hGetContents h
stylish-haskell.cabal view
@@ -1,5 +1,5 @@ Name: stylish-haskell-Version: 0.5.17.0+Version: 0.6.0.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3@@ -30,14 +30,15 @@ Ghc-options: -Wall Other-modules:+ Language.Haskell.Stylish.Align Language.Haskell.Stylish.Block Language.Haskell.Stylish.Config Language.Haskell.Stylish.Editor Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Step+ Language.Haskell.Stylish.Step.SimpleAlign Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.LanguagePragmas- Language.Haskell.Stylish.Step.Records Language.Haskell.Stylish.Step.Tabs Language.Haskell.Stylish.Step.TrailingWhitespace Language.Haskell.Stylish.Step.UnicodeSyntax@@ -85,14 +86,28 @@ Type: exitcode-stdio-1.0 Other-modules:+ Language.Haskell.Stylish.Align+ Language.Haskell.Stylish.Block+ Language.Haskell.Stylish.Config+ Language.Haskell.Stylish.Editor+ Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Parse.Tests+ Language.Haskell.Stylish.Step+ Language.Haskell.Stylish.Step.SimpleAlign+ Language.Haskell.Stylish.Step.SimpleAlign.Tests+ Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.Imports.Tests+ Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.LanguagePragmas.Tests- Language.Haskell.Stylish.Step.Records.Tests+ Language.Haskell.Stylish.Step.Tabs Language.Haskell.Stylish.Step.Tabs.Tests+ Language.Haskell.Stylish.Step.TrailingWhitespace Language.Haskell.Stylish.Step.TrailingWhitespace.Tests+ Language.Haskell.Stylish.Step.UnicodeSyntax Language.Haskell.Stylish.Step.UnicodeSyntax.Tests Language.Haskell.Stylish.Tests.Util+ Language.Haskell.Stylish.Util+ Language.Haskell.Stylish.Verbose Build-depends: HUnit >= 1.2 && < 1.4,
tests/Language/Haskell/Stylish/Parse/Tests.hs view
@@ -16,12 +16,16 @@ -------------------------------------------------------------------------------- tests :: Test tests = testGroup "Language.Haskell.Stylish.Parse"- [ testCase "UTF-8 Byte Order Mark" testBom- , testCase "Extra extensions" testExtraExtensions- , testCase "Multiline CPP" testMultilineCpp- , testCase "Haskell2010 extension" testHaskell2010- , testCase "Shebang" testShebang- , testCase "ShebangExt" testShebangExt+ [ testCase "UTF-8 Byte Order Mark" testBom+ , testCase "Extra extensions" testExtraExtensions+ , testCase "Multiline CPP" testMultilineCpp+ , testCase "Haskell2010 extension" testHaskell2010+ , testCase "Shebang" testShebang+ , testCase "ShebangExt" testShebangExt+ , testCase "GADTs extension" testGADTs+ , testCase "KindSignatures extension" testKindSignatures+ , testCase "StandalonDeriving extension" testStandaloneDeriving+ , testCase "UnicodeSyntax extension" testUnicodeSyntax ] --------------------------------------------------------------------------------@@ -77,6 +81,38 @@ , "main = return ()" ] +--------------------------------------------------------------------------------++-- | These tests are for syntactic language extensions that should always be+-- enabled for parsing, even when the pragma is absent.++testGADTs :: Assertion+testGADTs = assert $ isRight $ parseModule [] Nothing $ unlines+ [ "module Main where"+ , "data SafeList a b where"+ , " Nil :: SafeList a Empty"+ , " Cons:: a -> SafeList a b -> SafeList a NonEmpty"+ ]++testKindSignatures :: Assertion+testKindSignatures = assert $ isRight $ parseModule [] Nothing $ unlines+ [ "module Main where"+ , "data D :: * -> * -> * where"+ , " D :: a -> b -> D a b"+ ]++testStandaloneDeriving :: Assertion+testStandaloneDeriving = assert $ isRight $ parseModule [] Nothing $ unlines+ [ "module Main where"+ , "deriving instance Show MyType"+ ]++testUnicodeSyntax :: Assertion+testUnicodeSyntax = assert $ isRight $ parseModule [] Nothing $ unlines+ [ "module Main where"+ , "monadic ∷ (Monad m) ⇒ m a → m a"+ , "monadic = id"+ ] -------------------------------------------------------------------------------- isRight :: Either a b -> Bool
− tests/Language/Haskell/Stylish/Step/Records/Tests.hs
@@ -1,56 +0,0 @@----------------------------------------------------------------------------------module Language.Haskell.Stylish.Step.Records.Tests- ( tests- ) where------------------------------------------------------------------------------------import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, (@=?))------------------------------------------------------------------------------------import Language.Haskell.Stylish.Step.Records-import Language.Haskell.Stylish.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "Language.Haskell.Stylish.Step.Records.Tests"- [ testCase "case 01" case01- , testCase "case 02" case02- ]------------------------------------------------------------------------------------case01 :: Assertion-case01 = expected @=? testStep step input- where- input = unlines- [ "data Foo = Foo"- , " { foo :: Int"- , " , barqux :: String"- , " } deriving (Show)"- ]-- expected = unlines- [ "data Foo = Foo"- , " { foo :: Int"- , " , barqux :: String"- , " } deriving (Show)"- ]------------------------------------------------------------------------------------case02 :: Assertion-case02 = input @=? testStep step input- where- -- Don't attempt to align this since a field spans multiple lines- input = unlines- [ "data Foo = Foo"- , " { foo :: Int"- , " , barqux"- , " :: String"- , " } deriving (Show)"- ]
+ tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs view
@@ -0,0 +1,150 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.SimpleAlign.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, (@=?))+++--------------------------------------------------------------------------------+import Language.Haskell.Stylish.Step.SimpleAlign+import Language.Haskell.Stylish.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Language.Haskell.Stylish.Step.SimpleAlign.Tests"+ [ testCase "case 01" case01+ , testCase "case 02" case02+ , testCase "case 03" case03+ , testCase "case 04" case04+ , testCase "case 05" case05+ , testCase "case 06" case06+ , testCase "case 07" case07+ ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = expected @=? testStep (step 80 defaultConfig) input+ where+ input = unlines+ [ "eitherToMaybe e = case e of"+ , " Left _ -> Nothing"+ , " Right x -> Just x"+ ]++ expected = unlines+ [ "eitherToMaybe e = case e of"+ , " Left _ -> Nothing"+ , " Right x -> Just x"+ ]+++--------------------------------------------------------------------------------+case02 :: Assertion+case02 = expected @=? testStep (step 80 defaultConfig) input+ where+ input = unlines+ [ "eitherToMaybe (Left _) = Nothing"+ , "eitherToMaybe (Right x) = Just x"+ ]++ expected = unlines+ [ "eitherToMaybe (Left _) = Nothing"+ , "eitherToMaybe (Right x) = Just x"+ ]+++--------------------------------------------------------------------------------+case03 :: Assertion+case03 = expected @=? testStep (step 80 defaultConfig) input+ where+ input = unlines+ [ "heady def [] = def"+ , "heady _ (x : _) = x"+ ]++ expected = unlines+ [ "heady def [] = def"+ , "heady _ (x : _) = x"+ ]+++--------------------------------------------------------------------------------+case04 :: Assertion+case04 = expected @=? testStep (step 80 defaultConfig) input+ where+ input = unlines+ [ "data Foo = Foo"+ , " { foo :: Int"+ , " , barqux :: String"+ , " } deriving (Show)"+ ]++ expected = unlines+ [ "data Foo = Foo"+ , " { foo :: Int"+ , " , barqux :: String"+ , " } deriving (Show)"+ ]+++--------------------------------------------------------------------------------+case05 :: Assertion+case05 = input @=? testStep (step 80 defaultConfig) input+ where+ -- Don't attempt to align this since a field spans multiple lines+ input = unlines+ [ "data Foo = Foo"+ , " { foo :: Int"+ , " , barqux"+ , " :: String"+ , " } deriving (Show)"+ ]+++--------------------------------------------------------------------------------+case06 :: Assertion+case06 =+ -- 22 max columns is /just/ enough to align this stuff.+ expected @=? testStep (step 22 defaultConfig) input+ where+ input = unlines+ [ "data Foo = Foo"+ , " { foo :: String"+ , " , barqux :: Int"+ , " }"+ ]++ expected = unlines+ [ "data Foo = Foo"+ , " { foo :: String"+ , " , barqux :: Int"+ , " }"+ ]+++--------------------------------------------------------------------------------+case07 :: Assertion+case07 =+ -- 21 max columns is /just NOT/ enough to align this stuff.+ expected @=? testStep (step 21 defaultConfig) input+ where+ input = unlines+ [ "data Foo = Foo"+ , " { foo :: String"+ , " , barqux :: Int"+ , " }"+ ]++ expected = unlines+ [ "data Foo = Foo"+ , " { foo :: String"+ , " , barqux :: Int"+ , " }"+ ]
tests/TestSuite.hs view
@@ -5,14 +5,14 @@ ---------------------------------------------------------------------------------import Test.Framework (defaultMain)+import Test.Framework (defaultMain) -------------------------------------------------------------------------------- import qualified Language.Haskell.Stylish.Parse.Tests import qualified Language.Haskell.Stylish.Step.Imports.Tests import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests-import qualified Language.Haskell.Stylish.Step.Records.Tests+import qualified Language.Haskell.Stylish.Step.SimpleAlign.Tests import qualified Language.Haskell.Stylish.Step.Tabs.Tests import qualified Language.Haskell.Stylish.Step.TrailingWhitespace.Tests import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests@@ -24,7 +24,7 @@ [ Language.Haskell.Stylish.Parse.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests , Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests- , Language.Haskell.Stylish.Step.Records.Tests.tests+ , Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests , Language.Haskell.Stylish.Step.Tabs.Tests.tests , Language.Haskell.Stylish.Step.TrailingWhitespace.Tests.tests , Language.Haskell.Stylish.Step.UnicodeSyntax.Tests.tests