Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Major changes.

  • Loading branch information...
commit 369956a2caca95376eb942ed5f861625fd4b31e9 1 parent 9347ef9
@jgm authored
View
7 HeX.cabal
@@ -18,17 +18,14 @@ Library
Text.HeX.Html
Build-depends: parsec >= 3.1, base >= 4 && < 5,
mtl, containers,
- bytestring, utf8-string, blaze-builder >= 0.1 && < 0.2
+ bytestring, utf8-string, blaze-builder >= 0.2 && < 0.3
if impl(ghc >= 6.12)
Ghc-Options: -Wall -fno-warn-unused-do-bind
else
Ghc-Options: -Wall
Executable hexto
Main-is: hexto.hs
- Build-depends: parsec >= 3.1, base >= 4 && < 5,
- filepath, directory, mtl, containers, directory,
- bytestring, utf8-string, blaze-builder >= 0.1 && < 0.2,
- hint >= 0.3 && < 0.4, split >= 0.1 && < 0.2
+ Build-depends: filepath, directory, process
if impl(ghc >= 6.12)
Ghc-Options: -Wall -fno-warn-unused-do-bind
else
View
2  Setup.hs
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
View
52 TODO
@@ -1,41 +1,25 @@
-Ideas:
+my.hex:
+------------
+\title{This is my document!}
-* hugs w/ no fanciness:
+Here's my \emph{text}.
+------------
- runhugs test.txt
+my.hs:
+------------
+import Text.HeX
- is all you need. put the source is comments!
+main = defaultMain parsers
+------------
-* Forget ghc! Use HUGS!
- hugs +l loads ANY file as literate Haskell.
- -Fcmd Set preprocessor filter for source files to cmd (unset by
- default). Instead of reading a source file directly, Hugs will
- read the standard output of cmd run with the source file name as
- argument.
+hexto html /dir/my.hex:
+- looks for /dir/my.hex
+- if found, looks for /dir/my.hs
+- else error
+- if found, runs it with: 'runghc $OPTS /dir/my.hs html',
+ taking input from /dir/my.hex, output to --output file
+ if specified or stdout
+- else create it using default, then run as above
-Note: -pgmL cmd in ghc will use a custom "unlit" program.
-
-
-So, I could have a preprocessor, docproc, that parses the document &
-converts it into a Haskell program, and a shell script, docrun,
-that calls runhugs +Fdocproc on the document.
-
-docrun -t html mydoc.txt
-
-produces HTML!
-
-* currently we have a problem with stuff like this:
-\begin{Verbatim}
-> quoted
-\end{Verbatim}
-since the > line is interpreted as Haskell. We need a convention
-for "stop interpreting as literate Haskell after this line."
-
-* environments:
- \quote{
- blah blah
- }
-
- the quote command will strip off the initial newline.
View
7 Text/HeX.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, PatternGuards,
- TypeSynonymInstances, GeneralizedNewtypeDeriving #-}
+ TypeSynonymInstances, GeneralizedNewtypeDeriving, TemplateHaskell #-}
{- |
Module : Text.HeX
Copyright : Copyright (C) 2010 John MacFarlane
@@ -36,8 +36,8 @@ 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 as BU
+import Blaze.ByteString.Builder
+import Blaze.ByteString.Builder.Char.Utf8 as BU
import qualified Data.Map as M
import Data.Monoid
import Data.String
@@ -129,3 +129,4 @@ getNext :: HeX Doc
getNext = do
parsers <- liftM hexParsers getState
choice parsers
+
View
17 Text/HeX/Default.hs
@@ -19,12 +19,15 @@ module Text.HeX.Default
, math
, ensureMath
, base
+ , defaultMain
, module Text.HeX
)
where
import Text.Parsec
import Text.HeX
import qualified Data.ByteString.Lazy.UTF8 as U
+import qualified Data.ByteString.Lazy as L
+import System.Environment
import qualified Text.HeX.Html as Html
import qualified Text.HeX.TeX as TeX
import Control.Monad
@@ -55,9 +58,9 @@ class ToCommand a where
instance ToCommand (HeX Doc) where
toCommand x = x
-instance ToCommand (Format -> HeX Doc) where
+instance ToCommand a => ToCommand (Format -> a) where
toCommand x = do format <- liftM hexFormat getState
- x format
+ toCommand (x format)
instance ToCommand b => ToCommand (Doc -> b) where
toCommand x = do arg <- getNext
@@ -135,3 +138,13 @@ ensureMath p = do
base :: HeX Doc
base = math <|> group <|> oneChar
+
+defaultMain :: [HeX Doc] -> IO ()
+defaultMain parsers = do
+ inp <- getContents
+ args <- getArgs
+ when (null args) $ error "Specify output format"
+ let (format:_) = args
+ L.putStrLn =<< run (parsers ++ [base]) format inp
+
+
View
27 examples/simple.lhs
@@ -1,27 +0,0 @@
-> import Prelude hiding (repeat, pi)
-> import Text.HeX.Default
-> import Text.HeX.TeX as TeX
-> import Text.HeX.Html as Html
-
-> emph :: Doc -> Format -> HeX Doc
-> emph arg "html" = return $ inTags "em" [] arg
-> emph arg "tex" = return $ ctl "emph" +++ grp [arg]
-
-> pi :: HeX Doc
-> pi = ensureMath $ return "\\pi"
-
-> repeat :: Maybe Int -> Doc -> Doc
-> repeat (Just n) = cat . replicate n
-
-> parsers = [ command "repeat" repeat
-> , command "pi" pi
-> , command "em" emph
-> , base ]
-
-Here's the text & that text and some \em{emphasized text}.
-And some math: $e=mc^2$. And some display math: $$e=mc^2$$.
-
-\pi\ and $y = \pi$.
-
-\repeat[3]{hi there! }
-
View
46 hexto.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
-import Language.Haskell.Interpreter
import System.Environment
import qualified Data.ByteString.Lazy.Char8 as L
import Data.ByteString.Lazy.UTF8 (toString)
@@ -8,52 +7,9 @@ import System.Directory (getTemporaryDirectory, removeFile)
import System.IO
import Control.Exception (finally)
import Control.Monad
-import Data.List.Split
import Data.List (intercalate)
main :: IO ()
main = do
args <- getArgs
- (fmt,file) <- case args of
- [x,y] -> return (x,y)
- [x] -> return (x,"-")
- _ -> do hPutStrLn stderr $
- "Usage: hex FORMAT [FILE]"
- exitWith $ ExitFailure 1
- (code, txt) <- liftM splitSource $ if file == "-"
- then L.getContents
- else L.readFile file
- withTempFile "hextemph.lhs" $ \fp h -> do
- L.hPut h code
- hClose h
- res <- runInterpreter $ do
- set [languageExtensions := [OverloadedStrings]]
- loadModules [fp]
- setTopLevelModules ["Main"]
- setImports ["Data.ByteString.Lazy.Internal"]
- interpret ("run parsers") (as :: String -> String -> IO L.ByteString)
- case res of
- Left (UnknownError s) -> error s
- Left (WontCompile (e:_)) -> error $ replace fp file $ errMsg e
- Left (NotAllowed s) -> error s
- Left (GhcException s) -> error s
- Left err -> error $ show err
- Right f -> L.putStr =<< f fmt (toString txt)
- exitWith ExitSuccess
-
-withTempFile :: String -> (FilePath -> Handle -> IO a) -> IO a
-withTempFile patt f = do
- tempdir <- catch getTemporaryDirectory (\_ -> return ".")
- (tempfile, temph) <- openTempFile tempdir patt
- finally (f tempfile temph) (hClose temph >> removeFile tempfile)
-
-splitSource :: L.ByteString -> (L.ByteString, L.ByteString)
-splitSource src = (code, txt)
- where code = L.unlines $ map (zeroIf (not . isCodeLine)) srclines
- txt = L.unlines $ map (zeroIf isCodeLine) srclines
- srclines = L.lines src
- isCodeLine = L.isPrefixOf "> "
- zeroIf test ln = if test ln then "" else ln
-
-replace :: String -> String -> String -> String
-replace target replacement = intercalate replacement . splitOn target
+ print args
View
128 hugs/mywriter.hs
@@ -1,128 +0,0 @@
--- load with hugs -98
-
--- try:
--- unDoc mydoc stdout Html
--- test [command "emph" emph] "\emph{hi there} buddy" Html
-
-import qualified Data.Map as M
-import Data.Dynamic (Dynamic)
-import Data.Monoid
-import Control.Monad
-import System.IO
-import Text.ParserCombinators.Parsec
-
-data Format = Html | TeX deriving (Eq, Show, Read)
-
-newtype Doc = Doc { unDoc :: Handle -> Format -> IO () }
-
-instance Monoid Doc where
- mempty = Doc $ \_ _ -> return ()
- Doc x `mappend` Doc y = Doc $ \h f -> x h f >> y h f
-
-(+++) :: Doc -> Doc -> Doc
-(+++) = mappend
-
-data HeXState = HeXState{ hexParsers :: [HeX Doc] }
-
-type HeX = GenParser Char HeXState
-
-class ToCommand a where
- toCommand :: a -> HeX Doc
-
-instance ToCommand (HeX Doc) where
- toCommand x = x
-
-instance ToCommand b => ToCommand (Doc -> b) where
- toCommand x = try $ do arg <- getNext
- toCommand (x arg)
-
-instance (Read a, ToCommand b) => ToCommand (Maybe a -> b) where
- toCommand x = do opt <- getOpt
- toCommand (x opt)
-
-instance ToCommand Doc where
- toCommand x = return x
-
-getNext :: HeX Doc
-getNext = do
- parsers <- liftM hexParsers getState
- choice parsers
-
-readM :: (Read a, Monad m) => String -> m a
-readM s = case [x | (x,_) <- reads s] of
- [y] -> return y
- _ -> fail $ "Failed to parse `" ++ s ++ "'"
-
-getOpt :: Read a => HeX (Maybe a)
-getOpt = option Nothing $ try $ do
- char '['
- raw <- manyTill oneChar (char ']')
- return $ readM raw
-
-oneChar :: HeX Char
-oneChar = (char '\\' >> anyChar) <|> anyChar
-
-ch :: Char -> Doc
-ch c = Doc $ \h f ->
- case f of
- Html -> hPutHtmlChar h c
- TeX -> hPutTeXChar h c
-
-put :: Format -> Doc -> Doc
-put f (Doc d) = Doc $ \h f' -> if f == f'
- then d h f
- else return ()
-
-out :: Format -> Doc -> IO ()
-out format d = (unDoc d) stdout format
-
-lit :: String -> Doc
-lit x = Doc $ \h _ -> hPutStr h x
-
-str :: String -> Doc
-str x = Doc $ \h f ->
- case f of
- Html -> mapM_ (hPutHtmlChar h) x
- TeX -> mapM_ (hPutTeXChar h) x
-
-hPutHtmlChar h '&' = hPutStr h "&amp;"
-hPutHtmlChar h '<' = hPutStr h "&lt;"
-hPutHtmlChar h '>' = hPutStr h "&gt;"
-hPutHtmlChar h '"' = hPutStr h "&quot;"
-hPutHtmlChar h x = hPutChar h x
-
-hPutTeXChar h x = hPutChar h x
-
-tok :: HeX Doc
-tok = group <|> liftM ch oneChar
-
-emph :: Doc -> Doc
-emph x = put Html (lit "<em>" +++ x +++ lit "</em>") +++
- put TeX (lit "\\emph{" +++ x +++ lit "}")
-
-mydoc :: Doc
-mydoc = mconcat [
- str "hi"
- , emph $ str "hey"
- , str "there"
- ]
-
-group :: HeX Doc
-group = try $ do
- char '{'
- liftM mconcat $ manyTill getNext (char '}')
-
-command :: ToCommand a => String -> a -> HeX Doc
-command name cmd = try $ do
- char '\\'
- string name
- toCommand cmd
-
-parseHeX :: [HeX Doc] -> String -> Doc
-parseHeX ps s =
- case runParser (many getNext) HeXState{ hexParsers = ps ++ [tok] } "input" s of
- Right x -> mconcat x
- Left e -> error $ show e
-
-test ps s = unDoc (parseHeX ps s) stdout
-
View
1  test/test.hex
@@ -0,0 +1 @@
+Hi \emph{there}.
View
20 test/test.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Text.HeX.Default
+import Text.HeX.TeX as TeX
+import Text.HeX.Html as Html
+
+emph :: Format -> Doc -> Doc
+emph "html" arg = inTags "em" [] arg
+emph "tex" arg = ctl "emph" +++ grp [arg]
+
+name :: Format -> Doc -> Doc -> Doc
+name "html" f l = inTags "span" [("class","firstname")] f +++ " "
+ +++ inTags "span" [("class","lastname")] l
+
+rpt :: Maybe Int -> Doc -> Doc
+rpt (Just n) d = mconcat $ replicate n d
+rpt Nothing d = d
+
+main = defaultMain [ command "emph" emph, command "name" name,
+ command "rpt" rpt ]
+
Please sign in to comment.
Something went wrong with that request. Please try again.