hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Apply brittany

pull/8/head
Lennart Spitzner 2017-01-31 18:42:37 +01:00
parent bc70eb07e8
commit 93611b9a1c
1 changed files with 37 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
src-literatetests/Main.hs
View File

@ -42,8 +42,8 @@ main = do
hspec $ groups `forM_` \(groupname, tests) -> do hspec $ groups `forM_` \(groupname, tests) -> do
describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do
(if pend then before_ pending else id) (if pend then before_ pending else id)
$ it (Text.unpack name) $ roundTripEqual inp $ it (Text.unpack name)
$ roundTripEqual inp
where where
-- this function might be implemented in a weirdly complex fashion; the -- this function might be implemented in a weirdly complex fashion; the
-- reason being that it was copied from a somewhat more complex variant. -- reason being that it was copied from a somewhat more complex variant.
@ -55,58 +55,68 @@ main = do
-- l -> error $ "first non-empty line must start with #test footest\n" ++ show l -- l -> error $ "first non-empty line must start with #test footest\n" ++ show l
-- ) -- )
-- $ fmap (groupBy grouperT) -- $ fmap (groupBy grouperT)
fmap (\case fmap
( \case
GroupLine g:grouprest -> GroupLine g:grouprest ->
(,) g (,) g
$ fmap (\case $ fmap
HeaderLine n:PendingLine:rest | Just rlines <- mapM extractNormal rest -> (n, True, Text.unlines rlines) ( \case
HeaderLine n:rest | Just rlines <- mapM extractNormal rest -> (n, False, Text.unlines rlines) HeaderLine n:PendingLine:rest | Just rlines <- mapM
l -> error $ "first non-empty line must start with #test footest\n" ++ show l extractNormal
) rest ->
$ groupBy grouperT (n, True, Text.unlines rlines)
$ filter (not . lineIsSpace) HeaderLine n:rest | Just rlines <- mapM extractNormal rest ->
$ grouprest (n, False, Text.unlines rlines)
l ->
error
$ "first non-empty line must start with #test footest\n"
++ show l
)
$ groupBy grouperT
$ filter (not . lineIsSpace)
$ grouprest
l -> error $ "first non-empty line must be a #group\n" ++ show l l -> error $ "first non-empty line must be a #group\n" ++ show l
) )
$ groupBy grouperG $ groupBy grouperG
$ filter (not . lineIsSpace) $ filter (not . lineIsSpace)
$ lineMapper $ lineMapper
<$> Text.lines input <$> Text.lines input
where where
extractNormal (NormalLine l) = Just l extractNormal (NormalLine l) = Just l
extractNormal _ = Nothing extractNormal _ = Nothing
specialLineParser :: Parser InputLine specialLineParser :: Parser InputLine
specialLineParser = Parsec.choice specialLineParser = Parsec.choice
[ [ GroupLine $ Text.pack name [ [ GroupLine $ Text.pack name
| _ <- Parsec.try $ Parsec.string "#group" | _ <- Parsec.try $ Parsec.string "#group"
, _ <- Parsec.many1 $ Parsec.oneOf " \t" , _ <- Parsec.many1 $ Parsec.oneOf " \t"
, name <- Parsec.many1 $ Parsec.noneOf "\r\n:" , name <- Parsec.many1 $ Parsec.noneOf "\r\n:"
, _ <- Parsec.eof , _ <- Parsec.eof
] ]
, [ HeaderLine $ Text.pack name , [ HeaderLine $ Text.pack name
| _ <- Parsec.try $ Parsec.string "#test" | _ <- Parsec.try $ Parsec.string "#test"
, _ <- Parsec.many1 $ Parsec.oneOf " \t" , _ <- Parsec.many1 $ Parsec.oneOf " \t"
, name <- Parsec.many1 $ Parsec.noneOf "\r\n:" , name <- Parsec.many1 $ Parsec.noneOf "\r\n:"
, _ <- Parsec.eof , _ <- Parsec.eof
] ]
, [ PendingLine , [ PendingLine
| _ <- Parsec.try $ Parsec.string "#pending" | _ <- Parsec.try $ Parsec.string "#pending"
, _ <- Parsec.optional $ many (Parsec.noneOf "\r\n") , _ <- Parsec.optional $ many (Parsec.noneOf "\r\n")
, _ <- Parsec.eof , _ <- Parsec.eof
] ]
, [ CommentLine , [ CommentLine
| _ <- Parsec.many $ Parsec.oneOf " \t" | _ <- Parsec.many $ Parsec.oneOf " \t"
, _ <- Parsec.optional $ Parsec.string "##" <* many (Parsec.noneOf "\r\n") , _ <-
Parsec.optional $ Parsec.string "##" <* many (Parsec.noneOf "\r\n")
, _ <- Parsec.eof , _ <- Parsec.eof
] ]
] ]
lineMapper :: Text -> InputLine lineMapper :: Text -> InputLine
lineMapper line = case Parsec.runParser specialLineParser () "" line of lineMapper line = case Parsec.runParser specialLineParser () "" line of
Left _e -> NormalLine line Left _e -> NormalLine line
Right l -> l Right l -> l
lineIsSpace :: InputLine -> Bool lineIsSpace :: InputLine -> Bool
lineIsSpace CommentLine = True lineIsSpace CommentLine = True
lineIsSpace _ = False lineIsSpace _ = False
grouperG :: InputLine -> InputLine -> Bool grouperG :: InputLine -> InputLine -> Bool
grouperG _ GroupLine{} = False grouperG _ GroupLine{} = False
grouperG _ _ = True grouperG _ _ = True