More tests

driver/Main.hs

@@ -1,25 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
-import           System.IO
-import           System.Exit
 import           System.Environment
-
 import           Text.Markdown.Unlit
 
 main :: IO ()
-main = getArgs >>= \args -> case args of
-  -- GHC calls unlit like so:
-  --
-  -- > unlit -h label Foo.lhs /tmp/somefile
-  --
-  -- The label is meant to be used in line pragmas, like so:
-  --
-  -- #line 1 "label"
-  --
-  ["-h", _, infile, outfile] ->
-    fmap (unlit $ "haskell" :&: "literate") (readFile infile) >>= writeFile outfile
-  _ -> do
-    name <- getProgName
-    hPutStrLn stderr ("usage: " ++ name ++ " -h label infile outfile")
-    exitFailure
+main = getArgs >>= run

markdown-unlit.cabal

@@ -50,5 +50,7 @@ test-suite spec
   build-depends:
       base
     , stringbuilder
+    , directory
+    , silently
     , hspec >= 1.3
     , QuickCheck

src/Text/Markdown/Unlit.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 module Text.Markdown.Unlit (
-  unlit
+  run
+, unlit
 , Selector (..)
 , parseSelector
 , CodeBlock (..)
@@ -10,10 +11,31 @@ module Text.Markdown.Unlit (
 #endif
 ) where
 
-import Control.Applicative
-import Data.List
-import Data.Char
-import Data.String
+import           Control.Applicative
+import           Data.List
+import           Data.Char
+import           Data.String
+import           System.IO
+import           System.Exit
+import           System.Environment
+
+-- | Program entry point.
+run :: [String] -> IO ()
+run args = case args of
+  -- GHC calls unlit like so:
+  --
+  -- > unlit -h label Foo.lhs /tmp/somefile
+  --
+  -- The label is meant to be used in line pragmas, like so:
+  --
+  -- #line 1 "label"
+  --
+  ["-h", _, infile, outfile] ->
+    fmap (unlit $ Class "haskell" :&: Class "literate") (readFile infile) >>= writeFile outfile
+  _ -> do
+    name <- getProgName
+    hPutStrLn stderr ("usage: " ++ name ++ " -h label infile outfile")
+    exitFailure
 
 unlit :: Selector -> String -> String
 unlit selector = unlines . concatMap codeBlockContent . filter (toP selector . codeBlockClasses) . parse

test/Text/Markdown/UnlitSpec.hs

@@ -4,14 +4,43 @@ module Text.Markdown.UnlitSpec (main, spec) where
 import           Test.Hspec
 import           Test.QuickCheck
 import           Data.String.Builder
+import           System.Environment
+import           Control.Exception
+import           System.Exit
+import           System.IO.Silently
+import           System.IO
+import           System.Directory
+import qualified Control.Exception as E
 
 import           Text.Markdown.Unlit
 
 main :: IO ()
 main = hspec spec
 
+withTempFile :: (FilePath -> IO ()) -> IO ()
+withTempFile action = do
+  (f, h) <- openTempFile "." "hspec-tmp"
+  hClose h
+  action f `E.finally` removeFile f
+
 spec :: Spec
 spec = do
+  describe "run" $ do
+    it "prints a usage message" $ do
+      withProgName "foo" $ do
+        (r, Left (ExitFailure 1)) <- hCapture [stderr] (try $ run [])
+        r `shouldBe` "usage: foo -h label infile outfile\n"
+
+    it "unlits code marked with .literate and .haskell by default" $ do
+      withTempFile $ \infile -> withTempFile $ \outfile -> do
+        writeFile infile . build $ do
+          "~~~ {.haskell .literate}"
+          "some code"
+
+          "~~~"
+        run ["-h", "foo", infile, outfile]
+        readFile outfile `shouldReturn` "some code\n"
+
   describe "parseSelector" $ do
     it "parses + as :&:" $ do
       parseSelector "foo+bar+baz" `shouldBe` Just ("foo" :&: "bar" :&: "baz")