github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

add maybeFirstNewLine to look in Uls for new lines

Browse Source
This commit is contained in:
joshvera 2015-12-08 18:09:45 -05:00
parent f86f12b7f6
commit bcb935c49b
2 changed files with 37 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Split.hs
View File

@ -10,7 +10,7 @@ import Control.Comonad.Cofree
import Range
import Control.Monad.Free
import Data.ByteString.Lazy.Internal
import Text.Blaze.Html5
import Text.Blaze.Html5 hiding (map)
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html.Renderer.Utf8
import Data.Monoid
@ -27,6 +27,15 @@ data HTML =
| Dt String
deriving (Show, Eq)
maybeFirstNewLine :: HTML -> Maybe HTML
maybeFirstNewLine text@(Text "") = Just text
maybeFirstNewLine text@(Text _) = Nothing
maybeFirstNewLine (Span _ _) = Nothing
maybeFirstNewLine (Dt _) = Nothing
maybeFirstNewLine (Ul _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements
maybeFirstNewLine (Dl _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements
maybeFirstNewLine (Div _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements
classifyMarkup :: Maybe ClassName -> Markup -> Markup
classifyMarkup (Just className) element = element ! A.class_ (stringValue className)
classifyMarkup _ element = element
@ -172,8 +181,12 @@ adjoin2 [] row = [row]
adjoin2 (Row EmptyLine EmptyLine : init) row = adjoin2 init row
adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) =
Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init
adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) =
adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs@(Line (node : _)) ys) | Just _ <- maybeFirstNewLine node =
Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init
-- adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) =
-- Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init
adjoin2 rows row@(Row (Line (node : _)) _) | Just _ <- maybeFirstNewLine node = row : rows
adjoin2 rows row@(Row _ (Line (node : _))) | Just _ <- maybeFirstNewLine node = row : rows
adjoin2 (last:init) row = (last <> row) : init
{-

22
test/Spec.hs
View File

@ -77,6 +77,28 @@ main = hspec $ do
(Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ])
], (Range 0 8, Range 0 8))
it "" $
let (sourceA, sourceB) = ("[\na\n,\nb]", "[a,b]") in
annotatedToRows (formatted sourceA sourceB "branch" (Indexed [
Free . offsetAnnotated 2 1 $ unchanged "a" "leaf" (Leaf ""),
Free . offsetAnnotated 7 3 $ unchanged "b" "leaf" (Leaf "")
])) sourceA sourceB `shouldBe`
([
Row (Line [ Ul (Just "category-branch") [ Text "[" ] ])
(Line [ Ul (Just "category-branch") [ Text "[", span "a", Text ",", span "b", Text "]" ] ]),
Row (Line [ Ul (Just "category-branch") [ Text "", span "a" ] ])
EmptyLine,
Row (Line [ Ul (Just "category-branch") [ Text "", Text "," ] ])
EmptyLine,
Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ])
EmptyLine
], (Range 0 8, Range 0 5))
describe "adjoin2" $ do
it "appends a row starting with a newline" $
adjoin2 [ Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ] (Row (Line [ Text "", Text "," ]) EmptyLine) `shouldBe`
[ Row (Line [ Text "", Text "," ]) EmptyLine, Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ]
where
info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ])
unchanged source category = formatted source source category