diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Jasper Van der Jeugt + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jasper Van der Jeugt nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,49 @@ +-------------------------------------------------------------------------------- +module Main + ( main + ) where + + +-------------------------------------------------------------------------------- +import Control.Applicative ((<$>)) +import Data.Maybe (listToMaybe) +import System.Environment (getArgs) + + +-------------------------------------------------------------------------------- +import qualified StylishHaskell.Imports +import qualified StylishHaskell.LanguagePragmas +import StylishHaskell.Parse +import StylishHaskell.Stylish +import qualified StylishHaskell.Tabs +import qualified StylishHaskell.TrailingWhitespace + + +-------------------------------------------------------------------------------- +runStylish :: Maybe FilePath -> Stylish -> Lines -> Lines +runStylish mfp f ls = case parseModule mfp (unlines ls) of + Left err -> error err -- TODO: maybe return original lines? + Right module' -> f ls module' + + +-------------------------------------------------------------------------------- +chainStylish :: Maybe FilePath -> [Stylish] -> Lines -> Lines +chainStylish mfp filters = foldr (.) id filters' + where + filters' :: [Lines -> Lines] + filters' = map (runStylish mfp) filters + + +-------------------------------------------------------------------------------- +main :: IO () +main = do + filePath <- listToMaybe <$> getArgs + contents <- maybe getContents readFile filePath + putStr $ unlines $ chainStylish filePath filters $ lines contents + where + filters = + [ StylishHaskell.Imports.stylish + , StylishHaskell.LanguagePragmas.stylish + , StylishHaskell.Tabs.stylish + , StylishHaskell.TrailingWhitespace.stylish + ] diff --git a/src/StylishHaskell/Block.hs b/src/StylishHaskell/Block.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/Block.hs @@ -0,0 +1,60 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Block + ( Block (..) + , blockLength + , fromSrcSpanInfo + , moveBlock + , adjacent + , merge + , overlapping + ) where + + +-------------------------------------------------------------------------------- +import Control.Arrow (arr, (&&&), (>>>)) +import qualified Language.Haskell.Exts.Annotated as H + + +-------------------------------------------------------------------------------- +-- | Indicates a line span +data Block = Block + { blockStart :: Int + , blockEnd :: Int + } deriving (Eq, Ord, Show) + + +-------------------------------------------------------------------------------- +blockLength :: Block -> Int +blockLength (Block start end) = end - start + 1 + + +-------------------------------------------------------------------------------- +fromSrcSpanInfo :: H.SrcSpanInfo -> Block +fromSrcSpanInfo = H.srcInfoSpan >>> + H.srcSpanStartLine &&& H.srcSpanEndLine >>> + arr (uncurry Block) + + +-------------------------------------------------------------------------------- +moveBlock :: Int -> Block -> Block +moveBlock offset (Block start end) = Block (start + offset) (end + offset) + + +-------------------------------------------------------------------------------- +adjacent :: Block -> Block -> Bool +adjacent b1 b2 = follows b1 b2 || follows b2 b1 + where + follows (Block _ e1) (Block s2 _) = e1 + 1 == s2 + + +-------------------------------------------------------------------------------- +merge :: Block -> Block -> Block +merge (Block s1 e1) (Block s2 e2) = Block (min s1 s2) (max e1 e2) + + +-------------------------------------------------------------------------------- +overlapping :: [Block] -> Bool +overlapping blocks = + any (uncurry overlapping') $ zip blocks (drop 1 blocks) + where + overlapping' (Block _ e1) (Block s2 _) = e1 >= s2 diff --git a/src/StylishHaskell/Editor.hs b/src/StylishHaskell/Editor.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/Editor.hs @@ -0,0 +1,105 @@ +-------------------------------------------------------------------------------- +-- | This module provides you with a line-based editor. It's main feature is +-- that you can specify multiple changes at the same time, e.g.: +-- +-- > [deleteLine 3, changeLine 4 ["Foo"]] +-- +-- when this is evaluated, we take into account that 4th line will become the +-- 3rd line before it needs changing. +module StylishHaskell.Editor + ( Change + , applyChanges + + , change + , changeLine + , delete + , deleteLine + , insert + ) where + + +-------------------------------------------------------------------------------- +import StylishHaskell.Block +import StylishHaskell.Stylish + + +-------------------------------------------------------------------------------- +-- | Changes the lines indicated by the 'Block' into the given 'Lines' +data Change = Change + { changeBlock :: Block + , changeLines :: Lines + } deriving (Eq, Show) + + +-------------------------------------------------------------------------------- +moveChange :: Int -> Change -> Change +moveChange offset (Change block ls) = Change (moveBlock offset block) ls + + +-------------------------------------------------------------------------------- +-- | Number of additional lines introduced when a change is made. +changeExtraLines :: Change -> Int +changeExtraLines (Change block ls) = length ls - blockLength block + + +-------------------------------------------------------------------------------- +applyChanges :: [Change] -> Lines -> Lines +applyChanges changes + | overlapping blocks = error $ + "StylishHaskell.Editor.applyChanges: " ++ + "refusing to make overlapping changes" + | otherwise = go 1 changes + where + blocks = map changeBlock changes + + go _ [] ls = ls + go n (ch : chs) ls = + -- Divide the remaining lines into: + -- + -- > pre + -- > old (lines that are affected by the change) + -- > post + -- + -- And generate: + -- + -- > pre + -- > new + -- > (recurse) + -- + let block = changeBlock ch + (pre, ls') = splitAt (blockStart block - n) ls + (_, post) = splitAt (blockLength block) ls' + extraLines = changeExtraLines ch + chs' = map (moveChange extraLines) chs + n' = blockStart block + blockLength block + extraLines + in pre ++ (changeLines ch) ++ go n' chs' post + + +-------------------------------------------------------------------------------- +-- | Change a block of lines for some other lines +change :: Block -> Lines -> Change +change = Change + + +-------------------------------------------------------------------------------- +-- | Change a single line for some other lines +changeLine :: Int -> Lines -> Change +changeLine start = change (Block start start) + + +-------------------------------------------------------------------------------- +-- | Delete a block of lines +delete :: Block -> Change +delete block = Change block [] + + +-------------------------------------------------------------------------------- +-- | Delete a single line +deleteLine :: Int -> Change +deleteLine start = delete (Block start start) + + +-------------------------------------------------------------------------------- +-- | Insert something /before/ the given lines +insert :: Int -> Lines -> Change +insert start = Change (Block start (start - 1)) diff --git a/src/StylishHaskell/Imports.hs b/src/StylishHaskell/Imports.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/Imports.hs @@ -0,0 +1,110 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Imports + ( stylish + ) where + + +-------------------------------------------------------------------------------- +import Control.Arrow ((&&&)) +import Data.Char (isAlpha) +import Data.List (sortBy) +import Data.Maybe (isJust, maybeToList) +import Data.Ord (comparing) +import qualified Language.Haskell.Exts.Annotated as H + + +-------------------------------------------------------------------------------- +import StylishHaskell.Block +import StylishHaskell.Editor +import StylishHaskell.Stylish +import StylishHaskell.Util + + +-------------------------------------------------------------------------------- +imports :: H.Module l -> [H.ImportDecl l] +imports (H.Module _ _ _ is _) = is +imports _ = [] + + +-------------------------------------------------------------------------------- +importName :: H.ImportDecl l -> String +importName i = let (H.ModuleName _ n) = H.importModule i in n + + +-------------------------------------------------------------------------------- +longestImport :: [H.ImportDecl l] -> Int +longestImport = maximum . map (length . importName) + + +-------------------------------------------------------------------------------- +-- | Groups adjacent imports into larger import blocks +groupAdjacent :: [H.ImportDecl Block] -> [(Block, [H.ImportDecl Block])] +groupAdjacent = foldr step [] + where + -- This code is ugly and not optimal, and no fucks were given. + step 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 (importName &&& H.importQualified) + + +-------------------------------------------------------------------------------- +-- | The implementation is a bit hacky to get proper sorting for input specs: +-- constructors first, followed by functions, and then operators. +compareImportSpecs :: H.ImportSpec l -> H.ImportSpec l -> Ordering +compareImportSpecs = comparing key + where + key :: H.ImportSpec l -> (Int, Int, String) + key (H.IVar _ x) = let n = nameToString x in (1, operator n, n) + key (H.IAbs _ x) = (0, 0, nameToString x) + key (H.IThingAll _ x) = (0, 0, nameToString x) + key (H.IThingWith _ x _) = (0, 0, nameToString x) + + operator [] = 0 -- But this should not happen + operator (x : _) = if isAlpha x then 0 else 1 + + +-------------------------------------------------------------------------------- +-- | Sort the input spec list inside an 'H.ImportDecl' +sortImportSpecs :: H.ImportDecl l -> H.ImportDecl l +sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp} + where + sort (H.ImportSpecList l h specs) = H.ImportSpecList l h $ + sortBy compareImportSpecs specs + + +-------------------------------------------------------------------------------- +prettyImport :: Int -> H.ImportDecl l -> String +prettyImport longest imp = unwords $ concat + [ ["import"] + , [if H.importQualified imp then "qualified" else " "] + , [(if hasExtras then padRight longest else id) (importName imp)] + , ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] + , [H.prettyPrint specs | specs <- maybeToList $ H.importSpecs imp] + ] + where + hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp) + + +-------------------------------------------------------------------------------- +prettyImportGroup :: Int -> [H.ImportDecl Block] -> Lines +prettyImportGroup longest = map (prettyImport longest) . sortBy compareImports + + +-------------------------------------------------------------------------------- +stylish :: Stylish +stylish ls (module', _) = flip applyChanges ls + [ change block (prettyImportGroup longest importGroup) + | (block, importGroup) <- groups + ] + where + imps = map sortImportSpecs $ imports $ fmap fromSrcSpanInfo module' + longest = longestImport imps + groups = groupAdjacent imps diff --git a/src/StylishHaskell/LanguagePragmas.hs b/src/StylishHaskell/LanguagePragmas.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/LanguagePragmas.hs @@ -0,0 +1,53 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.LanguagePragmas + ( stylish + ) where + + +-------------------------------------------------------------------------------- +import Data.List (nub, sort) +import qualified Language.Haskell.Exts.Annotated as H + + +-------------------------------------------------------------------------------- +import StylishHaskell.Block +import StylishHaskell.Editor +import StylishHaskell.Stylish +import StylishHaskell.Util + + +-------------------------------------------------------------------------------- +pragmas :: H.Module l -> [(l, [String])] +pragmas (H.Module _ _ ps _ _) = + [(l, map nameToString names) | H.LanguagePragma l names <- ps] +pragmas _ = [] + + +-------------------------------------------------------------------------------- +-- | The start of the first block +firstLocation :: [(Block, [String])] -> Int +firstLocation = minimum . map (blockStart . fst) + + +-------------------------------------------------------------------------------- +-- | TODO: multiple lines if longer than 80 columns +prettyPragmas :: [String] -> Lines +prettyPragmas pragmas' = + [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}" + | pragma <- pragmas' + ] + where + longest = maximum $ map length pragmas' + + +-------------------------------------------------------------------------------- +stylish :: Stylish +stylish ls (module', _) + | null pragmas' = ls + | otherwise = applyChanges changes ls + where + pragmas' = pragmas $ fmap fromSrcSpanInfo module' + deletes = map (delete . fst) pragmas' + uniques = nub $ sort $ concatMap snd pragmas' + loc = firstLocation pragmas' + changes = insert loc (prettyPragmas uniques) : deletes diff --git a/src/StylishHaskell/Parse.hs b/src/StylishHaskell/Parse.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/Parse.hs @@ -0,0 +1,41 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Parse + ( parseModule + ) where + + +-------------------------------------------------------------------------------- +import Data.Maybe (fromMaybe) +import qualified Language.Haskell.Exts.Annotated as H + + +-------------------------------------------------------------------------------- +import StylishHaskell.Stylish + + +-------------------------------------------------------------------------------- +-- | Filter out lines which use CPP macros +unCpp :: String -> String +unCpp = unlines . map unCpp' . lines + where + unCpp' ('#' : _) = "" + unCpp' xs = xs + + +-------------------------------------------------------------------------------- +-- | Abstraction over HSE's parsing +parseModule :: Maybe FilePath -> String -> Either String Module +parseModule mfp string = + let fp = fromMaybe "" mfp + -- Determine the extensions used in the file, and update the parsing + -- mode based upon those + exts = fromMaybe [] $ H.readExtensions string + mode = H.defaultParseMode + {H.extensions = exts, H.fixities = Nothing} + -- Special handling for CPP, haskell-src-exts can't deal with it + string' = if H.CPP `elem` exts then unCpp string else string + in case H.parseModuleWithComments mode string' of + H.ParseOk md -> Right md + err -> Left $ + "StylishHaskell.Parse.parseModule: could not parse " ++ + fp ++ ": " ++ show err diff --git a/src/StylishHaskell/Stylish.hs b/src/StylishHaskell/Stylish.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/Stylish.hs @@ -0,0 +1,23 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Stylish + ( Lines + , Module + , Stylish + ) where + + +-------------------------------------------------------------------------------- +import qualified Language.Haskell.Exts.Annotated as H + + +-------------------------------------------------------------------------------- +type Lines = [String] + + +-------------------------------------------------------------------------------- +-- | Concrete module type +type Module = (H.Module H.SrcSpanInfo, [H.Comment]) + + +-------------------------------------------------------------------------------- +type Stylish = Lines -> Module -> Lines diff --git a/src/StylishHaskell/Tabs.hs b/src/StylishHaskell/Tabs.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/Tabs.hs @@ -0,0 +1,21 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Tabs + ( stylish + ) where + + +-------------------------------------------------------------------------------- +import StylishHaskell.Stylish + + +-------------------------------------------------------------------------------- +removeTabs :: String -> String +removeTabs = concatMap removeTabs' + where + removeTabs' '\t' = " " + removeTabs' x = [x] + + +-------------------------------------------------------------------------------- +stylish :: Stylish +stylish ls _ = map removeTabs ls diff --git a/src/StylishHaskell/TrailingWhitespace.hs b/src/StylishHaskell/TrailingWhitespace.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/TrailingWhitespace.hs @@ -0,0 +1,22 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.TrailingWhitespace + ( stylish + ) where + + +-------------------------------------------------------------------------------- +import Data.Char (isSpace) + + +-------------------------------------------------------------------------------- +import StylishHaskell.Stylish + + +-------------------------------------------------------------------------------- +dropTrailingWhitespace :: String -> String +dropTrailingWhitespace = reverse . dropWhile isSpace . reverse + + +-------------------------------------------------------------------------------- +stylish :: Stylish +stylish ls _ = map dropTrailingWhitespace ls diff --git a/src/StylishHaskell/Util.hs b/src/StylishHaskell/Util.hs new file mode 100644 --- /dev/null +++ b/src/StylishHaskell/Util.hs @@ -0,0 +1,21 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Util + ( nameToString + , padRight + ) where + + +-------------------------------------------------------------------------------- +import qualified Language.Haskell.Exts.Annotated as H + + +-------------------------------------------------------------------------------- +-- | TODO: put this in utilities? +nameToString :: H.Name l -> String +nameToString (H.Ident _ str) = str +nameToString (H.Symbol _ str) = str + + +-------------------------------------------------------------------------------- +padRight :: Int -> String -> String +padRight len str = str ++ replicate (len - length str) ' ' diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal new file mode 100644 --- /dev/null +++ b/stylish-haskell.cabal @@ -0,0 +1,64 @@ +Name: stylish-haskell +Version: 0.1.0.0 +Synopsis: Haskell code prettifier +Homepage: https://github.com/jaspervdj/stylish-haskell +License: BSD3 +License-file: LICENSE +Author: Jasper Van der Jeugt +Maintainer: Jasper Van der Jeugt +Copyright: 2012 Jasper Van der Jeugt +Category: Language +Build-type: Simple +Cabal-version: >= 1.8 + +Description: + A Haskell code prettifier. For more information, see: + + . + + + +Executable stylish-haskell + Ghc-options: -Wall + Hs-source-dirs: src + Main-is: Main.hs + + Other-modules: + StylishHaskell.Block + StylishHaskell.Editor + StylishHaskell.Imports + StylishHaskell.LanguagePragmas + StylishHaskell.Parse + StylishHaskell.Stylish + StylishHaskell.Tabs + StylishHaskell.TrailingWhitespace + StylishHaskell.Util + + Build-depends: + base >= 4 && < 5, + haskell-src-exts >= 1.13 && < 1.14 + +Test-suite stylish-haskell-tests + Ghc-options: -Wall + Hs-source-dirs: src tests + Main-is: TestSuite.hs + Type: exitcode-stdio-1.0 + + Other-modules: + StylishHaskell.Imports.Tests + StylishHaskell.LanguagePragmas.Tests + StylishHaskell.Tests.Util + StylishHaskell.Tabs.Tests + StylishHaskell.TrailingWhitespace.Tests + + Build-depends: + HUnit >= 1.2 && < 1.3, + test-framework >= 0.4 && < 0.7, + test-framework-hunit >= 0.2 && < 0.3, + -- Copied from regular dependencies... + base >= 4 && < 5, + haskell-src-exts >= 1.13 && < 1.14 + +Source-repository head + Type: git + Location: https://github.com/jaspervdj/stylish-haskell diff --git a/tests/StylishHaskell/Imports/Tests.hs b/tests/StylishHaskell/Imports/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/StylishHaskell/Imports/Tests.hs @@ -0,0 +1,51 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Imports.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@=?)) + + +-------------------------------------------------------------------------------- +import StylishHaskell.Imports +import StylishHaskell.Tests.Util + + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "StylishHaskell.Imports.Tests" + [ case01 + ] + + +-------------------------------------------------------------------------------- +case01 :: Test +case01 = testCase "case 01" $ expected @=? testStylish stylish input + where + input = unlines + [ "module Herp where" + , "" + , "import qualified Data.Map as M" + , "import Control.Monad" + , "import Data.Map (lookup, (!), insert, Map)" + , "" + , "import Herp.Derp.Internals" + , "" + , "herp = putStrLn \"import Hello world\"" + ] + + expected = unlines + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "" + , "import Herp.Derp.Internals" + , "" + , "herp = putStrLn \"import Hello world\"" + ] diff --git a/tests/StylishHaskell/LanguagePragmas/Tests.hs b/tests/StylishHaskell/LanguagePragmas/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/StylishHaskell/LanguagePragmas/Tests.hs @@ -0,0 +1,41 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.LanguagePragmas.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@=?)) + + +-------------------------------------------------------------------------------- +import StylishHaskell.LanguagePragmas +import StylishHaskell.Tests.Util + + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "StylishHaskell.LanguagePragmas.Tests" + [ case01 + ] + + +-------------------------------------------------------------------------------- +case01 :: Test +case01 = testCase "case 01" $ expected @=? testStylish stylish input + where + input = unlines + [ "{-# LANGUAGE ViewPatterns #-}" + , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" + , "{-# LANGUAGE ScopedTypeVariables #-}" + , "module Main where" + ] + + expected = unlines + [ "{-# LANGUAGE ScopedTypeVariables #-}" + , "{-# LANGUAGE TemplateHaskell #-}" + , "{-# LANGUAGE ViewPatterns #-}" + , "module Main where" + ] diff --git a/tests/StylishHaskell/Tabs/Tests.hs b/tests/StylishHaskell/Tabs/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/StylishHaskell/Tabs/Tests.hs @@ -0,0 +1,42 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.Tabs.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@=?)) + + +-------------------------------------------------------------------------------- +import StylishHaskell.Tabs +import StylishHaskell.Tests.Util + + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "StylishHaskell.Tabs.Tests" [case01] + + +-------------------------------------------------------------------------------- +case01 :: Test +case01 = testCase "case 01" $ expected @=? testStylish stylish input + where + input = unlines + [ "module Main" + , "\t\twhere" + , "data Foo" + , "\t= Bar" + , " | Qux" + ] + + expected = unlines + [ "module Main" + , " where" + , "data Foo" + , " = Bar" + , " | Qux" + ] + diff --git a/tests/StylishHaskell/Tests/Util.hs b/tests/StylishHaskell/Tests/Util.hs new file mode 100644 --- /dev/null +++ b/tests/StylishHaskell/Tests/Util.hs @@ -0,0 +1,17 @@ +module StylishHaskell.Tests.Util + ( testStylish + ) where + + +-------------------------------------------------------------------------------- +import StylishHaskell.Parse +import StylishHaskell.Stylish + + +-------------------------------------------------------------------------------- +testStylish :: Stylish -> String -> String +testStylish stylish str = case parseModule Nothing str of + Left err -> error err + Right module' -> unlines $ stylish ls module' + where + ls = lines str diff --git a/tests/StylishHaskell/TrailingWhitespace/Tests.hs b/tests/StylishHaskell/TrailingWhitespace/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/StylishHaskell/TrailingWhitespace/Tests.hs @@ -0,0 +1,37 @@ +-------------------------------------------------------------------------------- +module StylishHaskell.TrailingWhitespace.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@=?)) + + +-------------------------------------------------------------------------------- +import StylishHaskell.TrailingWhitespace +import StylishHaskell.Tests.Util + + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "StylishHaskell.TrailingWhitespace.Tests" [case01] + + +-------------------------------------------------------------------------------- +case01 :: Test +case01 = testCase "case 01" $ expected @=? testStylish stylish input + where + input = unlines + [ "module Main where" + , " " + , "data Foo = Bar | Qux\t " + ] + + expected = unlines + [ "module Main where" + , "" + , "data Foo = Bar | Qux" + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs new file mode 100644 --- /dev/null +++ b/tests/TestSuite.hs @@ -0,0 +1,25 @@ +-------------------------------------------------------------------------------- +module Main + ( main + ) where + + +-------------------------------------------------------------------------------- +import Test.Framework (defaultMain) + + +-------------------------------------------------------------------------------- +import qualified StylishHaskell.Imports.Tests +import qualified StylishHaskell.LanguagePragmas.Tests +import qualified StylishHaskell.Tabs.Tests +import qualified StylishHaskell.TrailingWhitespace.Tests + + +-------------------------------------------------------------------------------- +main :: IO () +main = defaultMain + [ StylishHaskell.Imports.Tests.tests + , StylishHaskell.LanguagePragmas.Tests.tests + , StylishHaskell.Tabs.Tests.tests + , StylishHaskell.TrailingWhitespace.Tests.tests + ]