diff options
| -rw-r--r-- | src/Weave.hs | 62 |
1 files changed, 48 insertions, 14 deletions
diff --git a/src/Weave.hs b/src/Weave.hs index f2d7836..4a61032 100644 --- a/src/Weave.hs +++ b/src/Weave.hs @@ -14,28 +14,62 @@ this program. If not, see <http://www.gnu.org/licenses/>. -} module Weave (weave) where +import Control.Monad (liftM) +import Data.Functor ((<$>)) + import Fragment weave :: [Fragment] -> Either String String -weave = Right . concatMap weaveFragment +weave = concatMapM weaveFragment -weaveFragment :: Fragment -> String -weaveFragment (Documentation text) = text -weaveFragment (BlockCode name body) = - "\\begin{LytBlockCode}{" ++ name ++ "}\n" - ++ weaveBlockBody body - ++ "\\end{LytBlockCode}\n" +weaveFragment :: Fragment -> Either String String +weaveFragment (Documentation text) = Right text +weaveFragment (BlockCode name body) = do + escapeCharacter <- texEscape <$> pickTexEscapeCharacter body + return $ "\\begin{LytBlockCode}{" ++ name ++ "}{" ++ escapeCharacter ++ "}\n" + ++ weaveBlockBody escapeCharacter body + ++ "\\end{LytBlockCode}\n" -weaveBlockBody :: [CodeOrReference] -> String -weaveBlockBody ((Code first):rest) = +weaveBlockBody :: String -> [CodeOrReference] -> String +weaveBlockBody escapeCharacter ((Code first):rest) = {- The first block is code. To make sure it gets typeset correctly, drop everything up to the first newline or non-space character. -} (case dropWhile (==' ') first of '\n' : first' -> first' first' -> first') - ++ concatMap weaveCodeOrReference rest -weaveBlockBody blocks = concatMap weaveCodeOrReference blocks + ++ concatMap (weaveCodeOrReference escapeCharacter) rest +weaveBlockBody escapeCharacter blocks = + concatMap (weaveCodeOrReference escapeCharacter) blocks + +weaveCodeOrReference :: String -> CodeOrReference -> String +weaveCodeOrReference _ (Code text) = text +weaveCodeOrReference escapeCharacter (Reference name) = + escapeCharacter ++ "\\LytFragmentReference{" ++ name ++ "}" ++ escapeCharacter + +pickTexEscapeCharacter :: [CodeOrReference] -> Either String Char +pickTexEscapeCharacter blocks = + case firstNotIn (consolidate blocks) texPotentialEscapeCharacters of + Just c -> Right c + Nothing -> Left "could not find a suitable LaTeX escape character" + where consolidate = foldl (\current block -> case block of + Code text -> current ++ text + Reference _ -> current) + "" + +firstNotIn :: Eq a => [a] -> [a] -> Maybe a +firstNotIn _ [] = Nothing +firstNotIn haystack (x:xs) + | x `elem` haystack = firstNotIn haystack xs + | otherwise = Just x + +texPotentialEscapeCharacters :: [Char] +texPotentialEscapeCharacters = + "!@#$%^&*()-_+={}[]|\"':;/?,.~`" ++ ['A' .. 'Z' ] ++ ['a' .. 'z'] + +texEscape :: Char -> String +texEscape char + | char `elem` "#$%^&_{}~" = ['\\', char] + | otherwise = [char] -weaveCodeOrReference :: CodeOrReference -> String -weaveCodeOrReference (Code text) = text -weaveCodeOrReference (Reference name) = "\\LytFragmentReference{" ++ name ++ "}" +concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] +concatMapM f lists = liftM concat $ mapM f lists |