diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -0,0 +1,6 @@ +Changelog +========= + +0.0.0.0 +-------- +Initial release. diff --git a/HaTeX-qq.cabal b/HaTeX-qq.cabal new file mode 100644 --- /dev/null +++ b/HaTeX-qq.cabal @@ -0,0 +1,44 @@ +name: HaTeX-qq +version: 0.0.0.0 +synopsis: Quasiquoters for HaTeX +description: Quasiquoters for HaTeX +license: BSD3 +license-file: LICENSE +author: Hiromi ISHII +maintainer: Hiromi ISHII +copyright: (c) Hiromi ISHII 2015 +category: Text +build-type: Simple +extra-source-files: Changelog.md +cabal-version: >=1.10 + +source-repository head + type: git + location: git://github.com/konn/HaTeX-qq.git + +library + exposed-modules: Text.LaTeX.QQ + other-modules: Text.LaTeX.QQ.Orphans + other-extensions: TemplateHaskell OverloadedStrings + build-depends: base >= 4 && <5, + uniplate == 1.6.*, + HaTeX == 3.15.*, + antiquoter == 0.1.*, + template-haskell >= 2.8 && < 2.10, + text >= 1.0 && < 1.2, + haskell-src-meta == 0.6.* + hs-source-dirs: src + default-language: Haskell2010 + + +-- test-suite spec +-- type: exitcode-stdio-1.0 +-- default-language: Haskell2010 +-- hs-source-dirs: test +-- ghc-options: -Wall +-- Main-is: Spec.hs +-- build-depends: base +-- , hspec +-- , QuickCheck +-- , HaTeX-qq +-- diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Hiromi ISHII + +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 Hiromi ISHII 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Text/LaTeX/QQ.hs b/src/Text/LaTeX/QQ.hs new file mode 100644 --- /dev/null +++ b/src/Text/LaTeX/QQ.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses, NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings, StandaloneDeriving, TemplateHaskell #-} +module Text.LaTeX.QQ (hat, hat', mkHaTeXQQ) where +import Text.LaTeX.QQ.Orphans () + +import Control.Monad ((<=<)) +import Data.Data (Typeable) +import Data.Generics.Uniplate.Direct (transform) +import qualified Data.Text as T +import Language.Haskell.AntiQuoter (AntiQuoterPass, (<>>)) +import Language.Haskell.Meta.Parse.Careful (parseExp, parsePat) +import Language.Haskell.TH (Exp, ExpQ, Pat, PatQ) +import Language.Haskell.TH (stringL) +import Language.Haskell.TH (litE, litP, sigE) +import Language.Haskell.TH (appE, viewP) +import Language.Haskell.TH.Quote (QuasiQuoter (..)) +import Language.Haskell.TH.Quote (dataToExpQ, dataToPatQ) +import Text.LaTeX (texy) +import Text.LaTeX.Base.Parser (parseLaTeX) +import Text.LaTeX.Base.Pretty (prettyLaTeX) +import Text.LaTeX.Base.Syntax (LaTeX (..), TeXArg (..)) + +-- | HaTeX quasiquoter. antiquote should be of the form of @\hask{...}@. +-- This quasiquoter is whitespace-sensitive both in input and output. +-- You need @OverloadedStrings@ language extension for pattern quotes. +-- +-- Since 0.0.0.0 +hat :: QuasiQuoter +hat = mkHaTeXQQ "hask" False + +-- | Whitespace-insensitive version of 'hat'. +-- Pattern quote requires @ViewPatterns@ in addition. +-- +-- Since 0.0.0.0 +hat' :: QuasiQuoter +hat' = mkHaTeXQQ "hask" True + +-- | General macro to generate quasiquoter for HaTeX. +-- You need @OverloadedStrings@ for pattern quotes, +-- and if the second argument is @True@, you also need @ViewPatterns@. +-- +-- NOTE: Due to TH's stage restriction, you have to use this function +-- in an other module than you call the resulting quasiquotes. +-- +-- Since 0.0.0.0 +mkHaTeXQQ :: String -- ^ Name for antiquoting latex command. + -> Bool -- ^ Ignore whitespaces? + -> QuasiQuoter +mkHaTeXQQ cmd triming = + let trimer | triming = trim + | otherwise = id + texTrimer | triming = viewP [| trimTeX |] + | otherwise = id + in QuasiQuoter { quoteType = const $ error "Type quoter not defined" + , quoteDec = const $ error "Dec quoter not defined" + , quoteExp = dataToExpQ (antiE cmd) <=< texExp . trimer + , quotePat = texTrimer . dataToPatQ (antiP cmd) <=< texExp . trimer + } + + +trim :: String -> String +trim = T.unpack . T.strip . T.pack + +texExp :: Monad m => String -> m LaTeX +texExp src = case parseLaTeX (T.pack src) of + Right t -> return t + Left err -> error $ "malformed latex: " ++ show err + +antiE :: Typeable e => String -> AntiQuoterPass e Exp +antiE cmd = antiTextE <>> antiE0 cmd <>> const Nothing + +antiE0 :: String -> LaTeX -> Maybe ExpQ +antiE0 cmd (TeXComm s [FixArg src]) | cmd == s = + case parseExp $ prettyLaTeX src of + Right e -> Just [| texy $(return e) |] + Left e -> error $ "haskell parsing error " ++ show e +antiE0 _ _ = Nothing + +antiP :: Typeable e => String -> AntiQuoterPass e Pat +antiP cmd = antiTextP <>> antiP0 cmd <>> const Nothing + +antiTextE :: T.Text -> Maybe ExpQ +antiTextE = Just . flip sigE [t| T.Text |] . appE [| T.pack |] . + litE . stringL . T.unpack + +antiTextP :: T.Text -> Maybe PatQ +antiTextP = Just . litP . stringL . T.unpack + +trimTeX :: LaTeX -> LaTeX +trimTeX = transform trimTeX0 + +trimTeX0 :: LaTeX -> LaTeX +trimTeX0 (TeXComment _) = TeXEmpty +trimTeX0 (TeXRaw t) = + let t' = T.strip t + in if T.null t' + then TeXEmpty + else TeXRaw t' +trimTeX0 TeXEmpty = TeXEmpty +trimTeX0 (TeXSeq TeXEmpty r) = r +trimTeX0 (TeXSeq l TeXEmpty) = l +trimTeX0 t = t + +antiP0 :: String -> LaTeX -> Maybe PatQ +antiP0 cmd (TeXComm name [FixArg src]) | cmd == name = + case parsePat $ prettyLaTeX src of + Right p -> Just $ return p + Left e -> error $ "haskell parsing error " ++ show e +antiP0 _ _ = Nothing + diff --git a/src/Text/LaTeX/QQ/Orphans.hs b/src/Text/LaTeX/QQ/Orphans.hs new file mode 100644 --- /dev/null +++ b/src/Text/LaTeX/QQ/Orphans.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Text.LaTeX.QQ.Orphans () where +import Data.Data (Data, Typeable) +import Data.Generics.Uniplate.Direct (Biplate (..), Uniplate (..), plate, (|*)) +import Data.Generics.Uniplate.Direct ((|-), (||*), (||+)) +import Text.LaTeX.Base.Syntax (LaTeX (..), MathType (..), Measure (..)) +import Text.LaTeX.Base.Syntax (TeXArg (..)) + +deriving instance Data LaTeX +deriving instance Data MathType +deriving instance Typeable MathType +deriving instance Data Measure +deriving instance Typeable Measure +deriving instance Data TeXArg +deriving instance Typeable TeXArg + +instance Biplate TeXArg LaTeX where + biplate (FixArg t) = plate FixArg |* t + biplate (OptArg t) = plate OptArg |* t + biplate (MOptArg ts) = plate MOptArg ||* ts + biplate (SymArg t) = plate SymArg |* t + biplate (MSymArg ts) = plate MSymArg ||* ts + biplate (ParArg t) = plate ParArg |* t + biplate (MParArg ts) = plate MParArg ||* ts + +instance Uniplate LaTeX where + uniplate (TeXRaw w) = plate TeXRaw |- w + uniplate (TeXComm s args) = plate TeXComm |- s ||+ args + uniplate (TeXCommS s) = plate TeXCommS |- s + uniplate (TeXEnv env args lat) = plate TeXEnv |- env ||+ args |* lat + uniplate (TeXMath typ lat) = plate TeXMath |- typ |* lat + uniplate (TeXLineBreak mm b) = plate TeXLineBreak |- mm |- b + uniplate (TeXBraces l) = plate TeXBraces |* l + uniplate (TeXComment t) = plate TeXComment |- t + uniplate (TeXSeq l r) = plate TeXSeq |* l |* r + uniplate TeXEmpty = plate TeXEmpty