diff --git a/heredoc.cabal b/heredoc.cabal
--- a/heredoc.cabal
+++ b/heredoc.cabal
@@ -1,5 +1,5 @@
name: heredoc
-version: 0.1.0.1
+version: 0.2.0.0
synopsis: multi-line string / here document using QuasiQuotes
description: multi-line string / here document using QuasiQuotes
@@ -16,7 +16,7 @@
cabal-version: >=1.8
library
- exposed-modules: Text.Here
+ exposed-modules: Text.Heredoc
build-depends:
base >= 4 && < 5,
template-haskell >= 2.5
diff --git a/src/Text/Here.hs b/src/Text/Here.hs
deleted file mode 100644
--- a/src/Text/Here.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-module Text.Here (here, there) where
-
-import Language.Haskell.TH
- ( litE
- , stringL
- )
-
-import Language.Haskell.TH.Quote
- ( QuasiQuoter
- ( QuasiQuoter
- , quoteExp
- , quotePat
- , quoteType
- , quoteDec
- )
- , quoteFile
- )
-
-err :: String -> String
-err ctx =
- "You have used the `here` QuasiQuoter in a " ++ ctx ++ " context; " ++
- "you must only use it as a string literal expression"
-
--- | Create a string-literal expression from the string being quoted.
-here :: QuasiQuoter
-here = QuasiQuoter
- { quoteExp = litE . stringL
- , quotePat = const $ error $ err "pattern"
- , quoteType = const $ error $ err "type"
- , quoteDec = const $ error $ err "declaration"
- }
-
--- | Create a string-literal expression from
--- the contents of the file at the filepath being quoted.
-there :: QuasiQuoter
-there = quoteFile here
diff --git a/src/Text/Heredoc.hs b/src/Text/Heredoc.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Heredoc.hs
@@ -0,0 +1,120 @@
+module Text.Heredoc (here, there, str) where
+
+import Data.Maybe (fromMaybe)
+import Data.List (intercalate)
+import Language.Haskell.TH
+ ( litE
+ , stringL
+ )
+
+import Language.Haskell.TH.Quote
+ ( QuasiQuoter
+ ( QuasiQuoter
+ , quoteExp
+ , quotePat
+ , quoteType
+ , quoteDec
+ )
+ , quoteFile
+ )
+
+data Ctx = Exp | Pat | Type | Dec
+
+qq :: String -> Ctx -> QuasiQuoter
+qq qqName correctCtx = QuasiQuoter
+ { quoteExp = const $ error $ errorString Exp
+ , quotePat = const $ error $ errorString Pat
+ , quoteType = const $ error $ errorString Type
+ , quoteDec = const $ error $ errorString Dec
+ }
+ where
+ errorString ctx =
+ "You have used the `" ++ qqName ++ "` QuasiQuoter " ++
+ "in " ++ ctxName ctx ++ " context; " ++
+ "you must only use it in " ++ ctxName correctCtx ++ " context"
+
+ ctxName c = case c of
+ Exp -> "an expression"
+ Pat -> "a pattern"
+ Type -> "a type"
+ Dec -> "a declaration"
+
+
+toUnix :: String -> String
+toUnix cs = case cs of
+ '\r':'\n' : cs -> '\n' : toUnix cs
+ '\r' : cs -> '\n' : toUnix cs
+ c : cs -> c : toUnix cs
+ [] -> []
+
+{-| Create a string-literal expression from the string being quoted.
+
+ Newline literals are normalized to UNIX newlines (one '\n' character).
+-}
+here :: QuasiQuoter
+here = (qq "here" Exp) { quoteExp = litE . stringL . toUnix }
+
+{-| Create a string-literal expression from
+ the contents of the file at the filepath being quoted.
+
+ Newline literals are normalized to UNIX newlines (one '\n' character).
+-}
+there :: QuasiQuoter
+there = quoteFile here
+
+{-| Create a multi-line string literal whose left edge is demarcated by the
+ "pipe" character ('|'). For example,
+
+ >famousQuote = [str|Any dictator would admire the
+ > |uniformity and obedience of the U.S. media.
+ > |
+ > | -- Noam Chomsky
+ > |]
+
+ is functionally equivalent to
+
+ >famousQuote = "Any dictator would admire the\n" ++
+ > "uniformity and obedience of the U.S. media.\n" ++
+ > "\n" ++
+ > " -- Noam Chomsky\n"
+
+ If desired, you can have a ragged left-edge, so
+
+ >myHtml = [str|
+ > |
+ > |My home page
+ > |
+ > |
+ > |]
+
+ is functionally equivalent to
+
+ >myHtml = "\n" ++
+ > "\n" ++
+ > "My home page
\n" ++
+ > "\n" ++
+ > "\n"
+-}
+str :: QuasiQuoter
+str = (qq "str" Exp)
+ { quoteExp = litE . stringL . intercalate "\n" . unPipe . lines . toUnix }
+ where
+ unPipe ls = case ls of
+ [] -> []
+ l : ls -> l : case splitLast ls of
+ Nothing -> []
+ Just (middles, last) ->
+ map removePipe middles ++ [fromMaybe "" (tryRemovePipe last)]
+ where
+ removePipe cs = case tryRemovePipe cs of
+ Nothing -> error "no pipe character found in line '" ++ cs ++ "'"
+ Just cs -> cs
+
+ tryRemovePipe cs = case dropWhile (/='|') cs of
+ [] -> Nothing
+ c:cs -> Just cs
+
+ splitLast :: [a] -> Maybe ([a], a)
+ splitLast xs = case reverse xs of
+ [] -> Nothing
+ l:i -> Just (reverse i, l)