authoring 0.2.3 → 0.3

raw patch · 6 files changed

+154/−4 lines, 6 filesdep +ansi-wl-pprintdep +parsersdep +template-haskell

Dependencies added: ansi-wl-pprint, parsers, template-haskell, trifecta

Files

• authoring.cabal +6/−1
• src/Text/Authoring/Class.hs +1/−0
• src/Text/Authoring/Combinator/Meta.hs +20/−2
• src/Text/Authoring/Label.hs +5/−1
• src/Text/Authoring/State.hs +3/−0
• src/Text/Authoring/TH.hs +119/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                authoring-version:             0.2.3+version:             0.3 synopsis:            A library for writing papers description:         This package is a combinator library for writing papers. homepage:            http://github.com/nushio3/authoring@@ -34,17 +34,22 @@     Text.Authoring.Document     Text.Authoring.Label     Text.Authoring.State+    Text.Authoring.TH   -- other-modules:          build-depends:       base ==4.*+    , ansi-wl-pprint     , citation-resolve >= 0.4.2     , containers >= 0.5     , data-default     , HaTeX >= 3.8     , lens     , mtl+    , parsers     , safe+    , template-haskell     , text+    , trifecta     , transformers    

@@ -27,3 +27,4 @@ runAuthoringT prog = do    (a,s,w) <- runRWST prog () def   return (a,s,w ^. latexSrc)+  

@@ -17,6 +17,14 @@   con   raw "}" +-- | command0 x = "\x "++command0 :: (MonadWriter t m, HasDocument t) =>  Text -> m ()+command0 x = do+  raw "\\"  +  raw x+  raw "{}"  +    -- | command1 x con = "\x{con}" @@ -28,6 +36,16 @@   con   raw "}"        +-- | commandI x con = "{\x con}"++commandI :: (MonadWriter t m, HasDocument t) =>  Text -> m () -> m ()+commandI x con = do+  raw "{\\"+  raw x+  raw " "+  con+  raw "}"+      -- | environment x con = "\begin{x}con\end{x}"       @@ -35,9 +53,9 @@ environment x con = do   raw "\\begin{"     raw x-  raw "}\n"  +  raw "}"     con   raw "\\end{"     raw x-  raw "}\n"  +  raw "}"   

@@ -1,5 +1,5 @@ module Text.Authoring.Label -       ( Label(..),(<>),(./))+       ( Label(..),(<>),(./), fromValue)        where  import           Data.Monoid@@ -32,6 +32,10 @@   show (Ap a b) = show a ++ "." ++ show b  infixl 1 ./++-- | Create a label from the type of a value.+fromValue :: Typeable t => t -> Label+fromValue = FromType . typeOf  -- | Create a slightly different version of the label. (./) :: Show a => Label -> a -> Label

@@ -14,6 +14,9 @@  import           Text.Authoring.Label +-- | The record type of everything you need to know+--   to write a paper.+ data AuthorState   = AuthorState   { _labelMap :: Map.Map Label Text

@@ -0,0 +1,119 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++This module provides quasi-quotes 'rawQ' and 'escQ' for writing papers. +The quasi-quotes will generate authoring monads, so you can use them in authoring +context like follows.++> paragraph = do+>   let takahashi2007 = citep ["isbn:9784130627184"] +>       val = 3e6+>   [rawQ| The dielectric strength of air is $ #{val} $ V/m @{takahashi2007}.  |]++We support antiquote syntax:++>  #{val}++for embedding values ('Show' instance is required), and++>  @{...}++for embedding authring monads.++-}++module Text.Authoring.TH (rawQ, escQ) where+++import Control.Applicative+import Data.Char (isSpace)+import Data.Monoid+import Data.Text (pack)+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Text.Trifecta+import Text.Trifecta.Delta+import Text.Parser.LookAhead+import Text.PrettyPrint.ANSI.Leijen as Pretty hiding (line, (<>), (<$>), empty, string)+import Safe (readMay)+import System.IO++import Text.Authoring.Combinator.Writer (raw, esc)+++-- | Quote with LaTeX special characters escaped. +escQ = rawQ {quoteExp =  parseE (QQConfig { escaper = appE (varE 'esc)})}++-- | Quote without escaping any special characters.                                                           +rawQ :: QuasiQuoter+rawQ = QuasiQuoter { +  quoteExp = parseE (QQConfig { escaper = appE (varE 'raw)}),+  quotePat  = error "Don't use Authoring QuasiQuotes in expression context" ,  +  quoteType = error "Don't use Authoring QuasiQuotes in expression context" ,  +  quoteDec  = error "Don't use Authoring QuasiQuotes in expression context" +  }++data QQConfig = QQConfig +  { escaper :: ExpQ -> ExpQ }+++parseE :: QQConfig -> String -> ExpQ+parseE cfg str = do+  let res = parseString parseLang (Columns 0 0) str+  case res of+    Failure xs -> do +      runIO $ do+        displayIO stdout $ renderPretty 0.8 80 $ xs <> linebreak+        putStrLn "Due to parse failure entire quote will be processed as a string."+      joinE $ map (cvtE cfg) $ [StrPart str]+    Success x -> joinE $ map (cvtE cfg) x+++cvtE :: QQConfig -> Component -> ExpQ+cvtE cfg (StrPart x)    = escaper cfg $ appE (varE 'pack) $ stringE x+cvtE cfg (EmbedShow x)  = escaper cfg $ appE (varE 'pack) $ appE (varE 'showJoin) (varE $ mkName $ trim x)+cvtE _   (EmbedMonad x) = (varE $ mkName $ trim x)                           ++trim :: String -> String+trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse++showJoin :: Show a => a -> String+showJoin x = maybe sx id rsx+  where +    sx :: String+    sx = show x+    rsx :: Maybe String+    rsx = readMay sx++joinE :: [ExpQ] -> ExpQ+joinE = foldl ap [e| return () |] +  where+    ap a b = appE (appE (varE '(>>) ) a ) b++data Component +  = StrPart    String+  | EmbedMonad String+  | EmbedShow  String deriving (Eq,Show)++parseLang :: Parser [Component]+parseLang = (many $ choice [try parseEmbedMonad, try parseEmbedShow, parseStrPart]) <* eof++parseStrPart :: Parser Component+parseStrPart = StrPart <$> go <?> "String Part"+  where+    go = do+      notFollowedBy $  choice [string "#{", string "@{"]+      h <- anyChar+      t <- manyTill anyChar (lookAhead $ choice [string "#{", string "@{", eof >> return ""])+      return $ h:t++parseEmbedMonad :: Parser Component+parseEmbedMonad = EmbedMonad <$> between (string "@{") (string "}") (some $ noneOf "}")+          <?> "Embed MonadAuthoring @{...}"+++parseEmbedShow :: Parser Component+parseEmbedShow = EmbedShow <$> between (string "#{") (string "}") (some $ noneOf "}")+          <?> "Embed an instance of Show #{...}"