fix add / remove backslash and add tests

Author: elaforge

src/StringLiteral.hs

@@ -16,7 +16,7 @@ import qualified System.Exit as Exit
 
 usage :: String
 usage =
-    "StrLit [ --wrapped --{add,remove,toggle}-{backslash,lines} ]\n\
+    "string-literal [ --wrapped --{add,remove,toggle}-{backslash,lines} ]\n\
     \\n\
     \Convert between plain text and either backslash-continued string\n\
     \literals, or list of lines style strings.  This is to work around\n\
@@ -108,7 +108,6 @@ collectNewlines = filter (not . Text.null) . snd . List.mapAccumL collect 0
         | Text.strip line == "" = (newlines+1, "")
         | otherwise = (0, Text.replicate newlines "\\n" <> line)
 
-
 {- | Invert 'addBackslashWrapped'.  Drop a leading space unless there was
     a leading \n.
 -}
@@ -130,21 +129,18 @@ removeBackslashWrapped =
         | otherwise = s
 
 addBackslash :: [Text] -> [Text]
-addBackslash = indent . map3 add1 addn end . map quote . dedent
+addBackslash = indent
+    . mapSurround ("\"", nl) ("\\", nl) ("\\", "\\n\"") ("\"", "\\n\"")
+    . map quote . dedent
     where
     nl = "\\n\\"
-    add1 s = "\"" <> s <> nl
-    addn s = "\\" <> s <> nl
-    end s = "\\" <> s <> "\\n\""
 
 removeBackslash :: [Text] -> [Text]
-removeBackslash = indent . map unquote . map3 start middle end . dedent
+removeBackslash = indent . map unquote
+    . mapStrip ("\"", nl) ("\\", nl) ("\\", "\\n\"") ("\"", "\\n\"")
+    . dedent
     where
-    start = stripPrefix "\"" . spaces . nl
-    middle = stripPrefix "\\" . spaces . nl
-    end = stripPrefix "\\" . spaces . stripSuffix "\\n\""
-    spaces = Text.dropWhile (==' ')
-    nl = stripSuffix "\\n\\"
+    nl = "\\n\\"
 
 -- * lines
 
@@ -212,6 +208,18 @@ mapAround start middle end only xs = case xs of
         [x] -> [end x]
         x : xs -> middle x : go xs
 
+mapSurround :: (Text, Text) -> (Text, Text) -> (Text, Text) -> (Text, Text)
+    -> [Text] -> [Text]
+mapSurround start middle end only =
+    mapAround (uncurry surround start) (uncurry surround middle)
+        (uncurry surround end) (uncurry surround only)
+
+mapStrip :: (Text, Text) -> (Text, Text) -> (Text, Text) -> (Text, Text)
+    -> [Text] -> [Text]
+mapStrip start middle end only =
+    mapAround (uncurry strip start) (uncurry strip middle)
+        (uncurry strip end) (uncurry strip only)
+
 surround :: Text -> Text -> Text -> Text
 surround s e x = s <> x <> e
 

src/StringLiteral_test.hs

@@ -11,6 +11,8 @@ main :: IO ()
 main = Tasty.defaultMain $ Tasty.testGroup "tests"
     [ test_backslashWrapped
     , test_backslashWrapped_roundTrip
+    , test_backslash
+    , test_backslash_roundTrip
     ]
 
 run :: Tasty.TestTree -> IO ()
@@ -51,49 +53,73 @@ test_backslashWrapped = Tasty.testGroup "backslashWrapped"
 -- it goes from reasonable input to the right haskell, and round trip will
 -- ensure it goes back to the original state.
 test_backslashWrapped_roundTrip :: Tasty.TestTree
-test_backslashWrapped_roundTrip = Tasty.testGroup "roundTrip"
-    [ backslashWrapped ["    one line"]
-    , backslashWrapped ["    two", "    lines"]
-    , backslashWrapped
+test_backslashWrapped_roundTrip = Tasty.testGroup "backslashWrapped_roundTrip" $
+    map trip
+    [ ["    one line"]
+    , ["    two", "    lines"]
+    ,
         [ "    with an"
         , "    explicit"
         , ""
         , "    newline"
         ]
     ]
     where
-    backslashWrapped = trip
+    trip = roundTrip
         StringLiteral.addBackslashWrapped StringLiteral.removeBackslashWrapped
 
-trip :: (Stack.HasCallStack, Show a, Eq a) => (a -> b) -> (b -> a) -> a
+test_backslash :: Tasty.TestTree
+test_backslash = Tasty.testGroup "backslash"
+    [ ["    one line"] ==> ["    \"one line\\n\""]
+    , ["    two", "    lines"] ==> ["    \"two\\n\\", "    \\lines\\n\""]
+    ,
+        [ "    with an"
+        , "    explicit"
+        , ""
+        , "    newline"
+        ] ==>
+        [ "    \"with an\\n\\"
+        , "    \\explicit\\n\\"
+        , "    \\\\n\\"
+        , "    \\newline\\n\""
+        ]
+    ,
+        [ "    with"
+        , "      explicit"
+        , "    indent"
+        ] ==>
+        [ "    \"with\\n\\"
+        , "    \\  explicit\\n\\"
+        , "    \\indent\\n\""
+        ]
+    ]
+    where
+    (==>) :: Stack.HasCallStack => [Text] -> [Text] -> Tasty.TestTree
+    (==>) = test StringLiteral.addBackslash
+
+test_backslash_roundTrip :: Tasty.TestTree
+test_backslash_roundTrip = Tasty.testGroup "backslash_roundTrip" $ map trip
+    [ ["    one line"]
+    , ["    two", "    lines"]
+    ,
+        [ "    with an"
+        , "    explicit"
+        , ""
+        , "    newline"
+        ]
+    ,
+        [ "    with"
+        , "      explicit"
+        , "    indent"
+        ]
+    ]
+    where
+    trip = roundTrip StringLiteral.addBackslash StringLiteral.removeBackslash
+
+roundTrip :: (Stack.HasCallStack, Show a, Eq a) => (a -> b) -> (b -> a) -> a
     -> Tasty.TestTree
-trip f g x = HUnit.testCase (take 70 $ show x) $ g (f x) HUnit.@?= x
+roundTrip f g x = HUnit.testCase (take 70 $ show x) $ g (f x) HUnit.@?= x
 
 test :: (Stack.HasCallStack, Show a, Eq b, Show b) => (a -> b) -> a -> b
     -> Tasty.TestTree
 test f x expected = HUnit.testCase (take 70 $ show x) $ f x HUnit.@?= expected
-
--- _test_addBackslash = Text.IO.putStr $ Text.unlines $ addBackslash
---     [ "    foo"
---     , ""
---     , "    bar"
---     ]
-
--- test1 = HUnit.testCase "test1"
---     [ [1, 2, 3] `compare` [1,2] === GT
---     , [1, 2, 3] `compare` [1,2,2] === LT
---     ]
-
--- unitTests :: Tasty.TestTree
--- unitTests = Tasty.testGroup "Unit tests"
---     [ HUnit.testCase "blah" $
---       [1, 2, 3] `compare` [1,2] @?= GT
---
---     -- the following test does not hold
---     , HUnit.testCase "List comparison (same length)" $
---       [1, 2, 3] `compare` [1,2,2] @?= LT
---     ]
-
-
-(===) :: (Eq a, Show a) => a -> a -> HUnit.Assertion
-(===) = (HUnit.@?=)