Permalink
Browse files

Clean up, add tabs and line length check

  • Loading branch information...
1 parent 9e34bc8 commit 704491808c68fce2ec150278091bb33fb1736c6d @jaspervdj jaspervdj committed Oct 27, 2011
Showing with 58 additions and 19 deletions.
  1. +40 −16 src/HStyle.hs
  2. +2 −1 src/HStyle/Alignment.hs
  3. +14 −0 src/HStyle/Block.hs
  4. +2 −2 src/HStyle/Types.hs
View
56 src/HStyle.hs
@@ -4,7 +4,7 @@ module HStyle
, main
) where
-import Control.Monad (forM_, unless)
+import Control.Monad (guard, forM_, unless)
import System.Environment (getArgs)
import qualified Data.Text as T
@@ -15,41 +15,65 @@ import HStyle.Alignment
import HStyle.Block
import HStyle.Types
-subBlock' :: H.SrcSpanInfo -> Block -> Block
-subBlock' ssi = subBlock start end
- where
- span' = H.srcInfoSpan ssi
- start = H.srcSpanStartLine span'
- end = H.srcSpanEndLine span'
-
runRule :: Block -> H.Module H.SrcSpanInfo -> Rule -> IO ()
-runRule block md (selector, check) = forM_ (selector md) $ \ssi -> do
- let block' = subBlock' ssi block
- problems = check block'
+runRule block md (selector, check) = forM_ (selector md block) $ \block' -> do
+ let problems = check block'
unless (null problems) $ do
T.putStrLn $ T.replicate 78 "-"
T.putStr $ prettyBlock block'
T.putStrLn $ T.replicate 78 "-"
forM_ problems $ \(i, problem) -> do
- let line = i + H.srcSpanStartLine (H.srcInfoSpan ssi)
+ let line = absoluteLineNumber i block'
T.putStrLn $ T.pack (show line) `T.append` ": " `T.append` problem
+ T.putStrLn ""
+
+fromSrcSpanInfo :: H.SrcSpanInfo -> Block -> Block
+fromSrcSpanInfo ssi = subBlock start end
+ where
+ span' = H.srcInfoSpan ssi
+ start = H.srcSpanStartLine span'
+ end = H.srcSpanEndLine span'
typeSigSelector :: Selector
-typeSigSelector (H.Module _ _ _ _ decls) = [ssi | H.TypeSig ssi _ _ <- decls]
-typeSigSelector _ = []
+typeSigSelector md block = map (flip fromSrcSpanInfo block) $ tss md
+ where
+ tss (H.Module _ _ _ _ decls) = [ssi | H.TypeSig ssi _ _ <- decls]
+ tss _ = []
typeSigCheck :: Check
typeSigCheck block = case checkAlignment alignment of
- Just _ -> [(0, "Bad alignment")]
+ Just _ -> [(1, "Bad alignment")]
Nothing -> []
where
alignment = alignmentOf ["::", "=>", "->"] $ toLines block
+selectAll :: Selector
+selectAll _ = return
+
+selectLines :: Selector
+selectLines _ = perLine
+
+tabsCheck :: Check
+tabsCheck block = do
+ (ln, text) <- zip [1 ..] (toLines block)
+ case T.findIndex (== '\t') text of
+ Nothing -> []
+ Just i -> [(ln , "\\t at column " `T.append` T.pack (show $ i + 1))]
+
+lineLengthCheck :: Int -> Check
+lineLengthCheck max' block = do
+ (ln, text) <- zip [1 ..] (toLines block)
+ guard $ T.length text > max'
+ return (ln , "exceeds max line length of " `T.append` T.pack (show max'))
+
main :: IO ()
main = do
[file] <- getArgs
contents <- readFile file
let block = fromText $ T.pack contents
case H.parseModule contents of
- H.ParseOk x -> runRule block x (typeSigSelector, typeSigCheck)
+ H.ParseOk md -> do
+ runRule block md (typeSigSelector, typeSigCheck)
+ runRule block md (selectLines, tabsCheck)
+ runRule block md (selectLines, lineLengthCheck 80)
err -> putStrLn $ show err
View
3 src/HStyle/Alignment.hs
@@ -8,6 +8,7 @@ import qualified Data.Text as T
type Lines = [Text]
type Alignment = [[(Int, Text)]]
+-- This is a really really long comment and I'm not sure if this is a good idea cause it might not fit on one line
checkAlignment :: Alignment
-> Maybe Text
checkAlignment alignment
@@ -16,7 +17,7 @@ checkAlignment alignment
| otherwise = Just "Improper alignment!"
where
alignment' = filter (not . null) alignment
- heads = map head alignment'
+ heads = map head alignment'
equal :: Eq a
=> [a]
View
14 src/HStyle/Block.hs
@@ -6,6 +6,8 @@ module HStyle.Block
, prettyBlock
, toLines
, subBlock
+ , perLine
+ , absoluteLineNumber
) where
import Data.Text (Text)
@@ -47,3 +49,15 @@ subBlock start end block = Block
{ blockOffset = blockOffset block + start - 1
, blockLines = V.slice (start - 1) (end - start + 1) $ blockLines block
}
+
+-- | Create a new block for every line.
+perLine :: Block -> [Block]
+perLine (Block offset lines') = map line $
+ zip [offset + 0 ..] $ V.toList lines'
+ where
+ line (i, t) = Block i $ V.singleton t
+
+-- | Convert relative line number (within this block, 1-based) to an absolute
+-- line number
+absoluteLineNumber :: Int -> Block -> Int
+absoluteLineNumber i = (+ i) . blockOffset
View
4 src/HStyle/Types.hs
@@ -10,10 +10,10 @@ import Language.Haskell.Exts.Annotated (Module, SrcSpanInfo)
import HStyle.Block
-- | Selects a portion from a haskell module
-type Selector = Module SrcSpanInfo -> [SrcSpanInfo]
+type Selector = Module SrcSpanInfo -> Block -> [Block]
-- | Takes a number of lines, and notifies of problems on each line. Indices in
--- the result are zero-based.
+-- the result are 1-based.
type Check = Block -> [(Int, Text)]
-- | A selector and a check...

0 comments on commit 7044918

Please sign in to comment.