Permalink
Browse files

Add updateSubBlock

  • Loading branch information...
1 parent a12f7d7 commit fb57a8418ceaab9ac044d5f4991767909df481d8 @jaspervdj jaspervdj committed Oct 30, 2011
Showing with 69 additions and 1 deletion.
  1. +1 −1 .ghci
  2. +21 −0 src/HStyle/Block.hs
  3. +39 −0 tests/HStyle/Block/Tests.hs
  4. +8 −0 tests/TestSuite.hs
View
@@ -1 +1 @@
-:set -isrc
+:set -isrc -itests
View
@@ -6,6 +6,7 @@ module HStyle.Block
, prettyBlock
, toLines
, subBlock
+ , updateSubBlock
, perLine
, absoluteLineNumber
, mapLines
@@ -52,6 +53,26 @@ subBlock start end block = Block
, blockLines = V.slice (start - 1) (end - start + 1) $ blockLines block
}
+-- | Update a subblock
+updateSubBlock :: Block -- ^ Old
+ -> Block -- ^ New
+ -> Block -- ^ Block to update
+ -> Block -- ^ Resulting block
+updateSubBlock old new block
+ | blockOffset old /= blockOffset new =
+ error "HStyle.Block.updateSubBlock: Internal error"
+ | otherwise = block
+ { blockLines = V.take subOffset lines' V.++ blockLines new V.++
+ V.drop (subOffset + V.length oldLines) lines'
+ }
+ where
+ subOffset
+ | blockOffset old == blockOffset new = blockOffset old
+ | otherwise = error
+ "HStyle.Block.updateSubBlock: Internal error"
+ oldLines = blockLines old
+ lines' = blockLines block
+
-- | Create a new block for every line.
perLine :: Block -> [Block]
perLine (Block offset lines') = map line $
@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+module HStyle.Block.Tests
+ ( tests
+ ) where
+
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, (@?=))
+import qualified Data.Text as T
+
+import HStyle.Block
+
+tests :: Test
+tests = testGroup "HStyle.Block.Tests"
+ [ testCase "subBlock_01" subBlock_01
+ , testCase "updateSubBlock_01" updateSubBlock_01
+ ]
+
+subBlock_01 :: Assertion
+subBlock_01 = toLines (subBlock 2 3 poem) @?=
+ ["A little man who wasn't there", "He wasn't there again today"]
+
+updateSubBlock_01 :: Assertion
+updateSubBlock_01 = toLines (updateSubBlock old new poem) @?=
+ [ "Last night I saw upon the stair"
+ , "A little man who wasn't there..."
+ , "He wasn't there again today..."
+ , "Oh, how I wish he'd go away"
+ ]
+ where
+ old = subBlock 2 3 poem
+ new = mapLines (`T.append` "...") old
+
+poem :: Block
+poem = fromText
+ "Last night I saw upon the stair\n\
+ \A little man who wasn't there\n\
+ \He wasn't there again today\n\
+ \Oh, how I wish he'd go away"
View
@@ -0,0 +1,8 @@
+import Test.Framework (defaultMain)
+
+import qualified HStyle.Block.Tests (tests)
+
+main :: IO ()
+main = defaultMain
+ [ HStyle.Block.Tests.tests
+ ]

0 comments on commit fb57a84

Please sign in to comment.