Permalink
Browse files

Initial commit.

  • Loading branch information...
0 parents commit 1edd8c0befa2f2bdc831950776fd37b194400b4e @jgm committed Aug 17, 2010
Showing with 241 additions and 0 deletions.
  1. +22 −0 HeX.cabal
  2. +30 −0 LICENSE
  3. +2 −0 Setup.hs
  4. +41 −0 TODO
  5. +124 −0 Text/HeX.hs
  6. +22 −0 examples/simple.lhs
@@ -0,0 +1,22 @@
+Name: HeX
+Version: 0.1
+Synopsis: A flexible text macro system.
+-- Description:
+License: BSD3
+License-file: LICENSE
+Author: John MacFarlane
+Maintainer: jgm@berkeley.edu
+Copyright: Copyright 2010 John MacFarlane
+Category: Text
+Build-type: Simple
+Extra-source-files: examples/test.lhs
+Cabal-version: >=1.2
+Library
+ Exposed-modules: Text.HeX
+ Build-depends: parsec >= 3.1, base >= 4,
+ filepath, directory, process, mtl, containers,
+ bytestring, utf8-string, blaze-builder >= 0.1 && < 0.2
+ if impl(ghc >= 6.12)
+ Ghc-Options: -Wall -fno-warn-unused-do-bind
+ else
+ Ghc-Options: -Wall
@@ -0,0 +1,30 @@
+Copyright (c)2010, John MacFarlane
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of John MacFarlane nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
@@ -0,0 +1,41 @@
+Make a data type
+
+data HeXDoc = HeXDoc { teXDoc :: TeX
+ , htmlDoc :: Html }
+
+instance Doc HeXDoc where
+
+Idea is that our parsers can then emit both TeX and HTML.
+Many will be combinators & will be neutral.
+
+Concept:
+
+- commands not latex syntax
+- instead, ;emph {hi there}
+- all commands have type
+ HeX Builder
+- so you can make an Html module and a TeX module for the
+ same set of macros, e.g.
+
+to a more flexible form of contextualism:
+\begin{definition}[Context-sensitive ought---flexible]
+An occurrence of ``$S$ ought to $\phi$'' at a context $c$ is
+true iff $\phi$-ing is the best course of action available to
+$S$ in light of the evidence relevant at $c$.
+\end{definition}
+
+to a more flexible form of contextualism:
+.definition [Context-sensitive ought---flexible]
+an occurrence of ``$S$ ought to $;phi$'' at a context $c$ is
+true iff $;phi$-ing is the best course of action available to
+$S$ in light of the evidence relevant at $c$.
+.
+
+the ;cmd are reg commands;
+they parse some number of arguments
+
+the |def> <def| are start/stop state-changers;
+they actually change the list of active parsers
+
+
+
@@ -0,0 +1,124 @@
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
+{- |
+ Module : Text.HeX
+ Copyright : Copyright (C) 2010 John MacFarlane
+ License : BSD3
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+
+A flexible text macro system. Users can define their own
+TeX-like macros (with arbitrary syntax). Multiple output
+formats can be supported by a single set of macros.
+-}
+
+module Text.HeX ( HeX
+ , use
+ , run
+ , setVar
+ , getVar
+ , updateVar
+ , (&)
+ , (==>)
+ , module Text.Parsec
+ , module Text.Blaze.Builder.Utf8
+ )
+where
+import Text.Parsec
+import Control.Monad
+import Data.Dynamic
+import qualified Data.ByteString.Lazy as L
+import Text.Blaze.Builder.Core
+import Text.Blaze.Builder.Utf8
+import qualified Data.Map as M
+import Data.Monoid
+import System.IO
+import System.Environment
+import System.Exit (ExitCode(..), exitWith)
+import System.FilePath
+import System.Directory
+
+data HeXState = HeXState { hexParsers :: [HeX Builder]
+ , hexFormat :: String
+ , hexVars :: M.Map String Dynamic }
+
+type HeX = ParsecT String HeXState IO
+
+setVar :: Typeable a => String -> a -> HeX a
+setVar name' v = do
+ updateState $ \s ->
+ s{ hexVars = M.insert name' (toDyn v) $ hexVars s }
+ return v
+
+getVar :: Typeable a => String -> HeX a
+getVar name' = do
+ vars <- liftM hexVars getState
+ case M.lookup name' vars of
+ Just v -> case fromDynamic v of
+ Just v' -> return v'
+ Nothing -> fail $ "Variable `" ++ name' ++
+ "' is of type " ++ show (dynTypeRep v)
+ Nothing -> fail $ "Variable `" ++ name' ++ "' has not been set."
+
+updateVar :: Typeable a => String -> (a -> a) -> HeX a
+updateVar name' f = getVar name' >>= setVar name' . f
+
+setParsers :: [HeX Builder] -> HeX ()
+setParsers parsers = updateState $ \s -> s{ hexParsers = parsers }
+
+run :: [HeX Builder] -> String -> String -> IO L.ByteString
+run parsers format contents = do
+ result <- runParserT (do setParsers parsers
+ spaces
+ manyTill (choice parsers <|>
+ fail "No matching parser.") eof)
+ HeXState{ hexParsers = []
+ , hexFormat = format
+ , hexVars = M.empty } "input" contents
+ case result of
+ Left e -> error (show e)
+ Right res -> return $ toLazyByteString $ mconcat $ res
+
+usage :: IO ()
+usage = do
+ prog' <- getInputFilePath
+ hPutStrLn stderr $ "HeX (c) 2010 John MacFarlane\n" ++
+ "Usage: ./" ++ prog' ++ " FORMAT"
+
+use :: [HeX Builder] -> IO ()
+use parsers = do
+ prog' <- getInputFilePath
+ args <- getArgs
+ format <- case args of
+ [x] -> return x
+ _ -> usage >> exitWith (ExitFailure 1)
+ txt <- liftM removeCode $ readFile prog'
+ res <- run parsers format txt
+ L.putStr res
+ exitWith ExitSuccess
+
+removeCode :: String -> String
+removeCode = unlines . map (\ln -> if isCommentLine ln then ln else "") . lines
+ where isCommentLine :: String -> Bool
+ isCommentLine ('>':_) = False
+ isCommentLine ('#':_) = False
+ isCommentLine _ = True
+
+getInputFilePath :: IO FilePath
+getInputFilePath = do
+ prog' <- getProgName >>= makeRelativeToCurrentDirectory
+ case takeExtension prog' of
+ ".lhs" -> return prog'
+ _ -> error $ "`" ++ prog' ++ "' is not a literate Haskell file."
+
+infixl 4 &
+(&) :: HeX Builder -> HeX Builder -> HeX Builder
+(&) = (<|>)
+
+infixr 7 ==>
+(==>) :: String -> Builder -> HeX Builder
+k ==> v = do
+ format <- liftM hexFormat getState
+ if format == k
+ then return v
+ else fail $ "I don't know how to render this in " ++ format
+
@@ -0,0 +1,22 @@
+#!/usr/bin/env runghc
+
+> import Text.HeX
+
+> oneChar = do
+> c <- anyChar
+> "html" ==> escapeHtmlChar c &
+> "tex" ==> escapeTeXChar c
+
+> escapeHtmlChar '&' = fromString "&amp;"
+> escapeHtmlChar '<' = fromString "&lt;"
+> escapeHtmlChar '>' = fromString "&gt;"
+> escapeHtmlChar c = fromChar c
+
+> escapeTeXChar c | c `elem` "$#&%" = fromString ['\\',c]
+> escapeTeXChar c | c `elem` "&~\\{}_^" = fromString $ "{\\char`\\" ++ [c] ++ "}"
+> escapeTeXChar c = fromChar c
+
+> main = use [oneChar]
+
+Here's the text & that text.
+

0 comments on commit 1edd8c0

Please sign in to comment.