latex-function-tables (empty) → 0.1.0.0
raw patch · 7 files changed
+399/−0 lines, 7 filesdep +HaTeXdep +basedep +bifunctorssetup-changed
Dependencies added: HaTeX, base, bifunctors, latex-function-tables, lens, mtl, process, semigroups, template-haskell, th-printf
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +58/−0
- latex-function-tables.cabal +53/−0
- src/Text/LaTeX/FunctionTable.hs +21/−0
- src/Text/LaTeX/Internal/FunctionTable.hs +230/−0
- test/Spec.hs +5/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Simon Hudon here (c) 2016++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 Simon Hudon 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings,TemplateHaskell #-}+module Main where++import Text.LaTeX+import Text.LaTeX.FunctionTable+import System.Process++short :: LaTeX+short = + documentclass [] article+ <> usepackage [] "multirow"+ <> title "A short message"+ <> author "John Short"+ <> document (mconcat + [ maketitle + , myTable + , newline <> newline+ , rendertex myFT+ , newline <> newline+ , "This is a paragraph"+ , newline <> newline+ , rendertex myFT' ])++myTable :: LaTeX+myTable = tabular Nothing [LeftColumn,RightColumn] $ execLaTeXM $ do+ textell $ "true" & "false"+ textell $ lnbk+ textell $ "false" & "true"+ textell $ lnbk+ textell $ "false" & "false"++myFT :: FunctionTable LaTeXLI+myFT = makeTable "Letter" $ do+ cell "a" "A"+ branch "b" $ do+ cell "c" "C"+ cell "\\neg c" "B"+ -- Condition (Cols 1) $ ("a", Cell "A") :| [("b", Condition (Cols 1) $ ("c",Cell "C") :| [("not c",Cell "B")])]++myFT' :: FunctionTable LaTeXLI+myFT' = makeTable "x" $ do+ cell "C0" "x_0"+ branch "\\neg C0" $ do+ branch "C1" $ do+ cell "C2" "x_2"+ cell "\\neg C2" "x_3"+ branch "\\neg C1" $ do+ cell "C2" "x_4"+ cell "\\neg C2" "x_5"++main :: IO ()+main = do+ renderFile "table.tex" short+ rawSystem "pdflatex" ["table.tex"]+ return ()++-- main = $(runIO (renderFile "table.tex" short >> rawSystem "pdflatex" ["table.tex"]) >> [| return () |])+-- main = renderFile "short.tex" short
+ latex-function-tables.cabal view
@@ -0,0 +1,53 @@+name: latex-function-tables+version: 0.1.0.0+synopsis: Function table specifications in latex+description: Please see README.md+homepage: https://github.com/githubuser/nfm2017#readme+license: BSD3+license-file: LICENSE+author: Simon Hudon+maintainer: simon.hudon@gmail.com+copyright: 2016 Simon Hudon+category: Text+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Text.LaTeX.FunctionTable+ Text.LaTeX.Internal.FunctionTable+ build-depends: base >= 4.7 && < 5+ , bifunctors+ , HaTeX+ , semigroups+ , lens+ , template-haskell+ , th-printf+ , mtl+ default-language: Haskell2010+ default-extensions: DeriveFunctor,DeriveFoldable,DeriveTraversable++executable example+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , HaTeX+ , process+ , latex-function-tables+ , template-haskell+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , latex-function-tables+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/unitb/latex-function-tables
+ src/Text/LaTeX/FunctionTable.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings,QuasiQuotes+ ,TemplateHaskell+ ,FlexibleInstances+ ,UndecidableInstances+ ,MultiParamTypeClasses+ ,FunctionalDependencies+ ,GeneralizedNewtypeDeriving #-}+module Text.LaTeX.FunctionTable + ( makeTable + , LaTeXLI (..)+ , FunctionTable + , FunctionTable' (..)+ , TableCells+ , TableCells' (..)+ , branch, cell + , subtables+ , isubtables+ )+where++import Text.LaTeX.Internal.FunctionTable
+ src/Text/LaTeX/Internal/FunctionTable.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE OverloadedStrings,QuasiQuotes+ ,ImplicitParams+ ,CPP+ ,TemplateHaskell+ ,ConstraintKinds+ ,FlexibleContexts+ ,FlexibleInstances+ ,StandaloneDeriving+ ,UndecidableInstances+ ,MultiParamTypeClasses+ ,FunctionalDependencies+ ,GeneralizedNewtypeDeriving #-}+module Text.LaTeX.Internal.FunctionTable where+++import Control.Applicative+import Control.Lens hiding ((&))+import Control.Monad.Writer++import Data.Bifoldable+import Data.Bitraversable+import Data.List as L+import Data.List.NonEmpty as N hiding (repeat)+import Data.Maybe+import Data.Semigroup hiding ((<>))+#if MIN_VERSION_base(4,9,0)+import GHC.Stack+#else+import GHC.Stack+import GHC.SrcLoc+#endif+import Text.LaTeX+import Text.LaTeX.Packages.AMSMath+import Text.LaTeX.Base.Syntax+import Text.LaTeX.Base.Class++data LaTeXLI = LaTeXLI SrcLoc String + deriving (Show,Eq)++data TableCells' a b = Cell b | Condition Cols (NonEmpty (a,TableCells' a b))+ deriving (Show,Eq,Functor,Foldable,Traversable)++data FunctionTable' a b = Table b (TableCells' a b)+ deriving (Show,Eq,Functor,Traversable,Foldable)++type TableCells a = TableCells' a a+type FunctionTable a = FunctionTable' a a++newtype Rows = Rows Int+ deriving (Show,Eq,Ord,Num)+newtype Cols = Cols Int+ deriving (Show,Eq,Ord,Num)++data Row a = Row [Either Filler Heading] a+ deriving (Show,Eq,Functor,Traversable,Foldable)++data Filler = Filler + { _fillerWidth :: Cols + , _fillerIsLast :: Bool+ }+ deriving (Show,Eq)++data Heading = Heading + { _title :: LaTeX + , _headingHeight :: Rows + , _headingWidth :: Cols + , _headingIsLast :: Bool+ }+ deriving (Show,Eq)++makePrisms ''TableCells'+makeFields ''Heading+makeFields ''Filler++instance Bifunctor FunctionTable' where+ bimap = bimapDefault+instance Bifunctor TableCells' where+ bimap = bimapDefault+instance Bifoldable FunctionTable' where+ bifoldMap = bifoldMapDefault+instance Bifoldable TableCells' where+ bifoldMap = bifoldMapDefault+instance Bitraversable FunctionTable' where+ bitraverse f g (Table h t) = liftA2 Table (g h) (bitraverse f g t)+instance Bitraversable TableCells' where+ bitraverse _ g (Cell x) = Cell <$> g x+ bitraverse f g (Condition w ts) = Condition w <$> traverse (bitraverse f $ bitraverse f g) ts++type Pre = (?loc :: CallStack)++subtables :: Traversal' (TableCells' a b) (a,TableCells' a b)+subtables _f x@(Cell _) = pure x+subtables f (Condition k xs) = Condition k <$> traverse f xs++isubtables :: IndexedTraversal' Int (TableCells' a b) (a,TableCells' a b)+isubtables _f x@(Cell _) = pure x+isubtables f (Condition k xs) = Condition k <$> itraverse (indexed f) xs++type M a = WriterT [(a,TableCells a)] Maybe++makeTable :: Pre+ => String + -> M LaTeXLI () + -> FunctionTable LaTeXLI+makeTable x t = Table (LaTeXLI (snd $ L.head $ getCallStack ?loc) x) + $ Condition (Cols 1) + $ fromJust $ nonEmpty =<< execWriterT t++cell :: Pre => String -> String -> M LaTeXLI ()+-- cell l x = tell [(math $ TeXRaw $ fromString l,Cell $ math $ TeXRaw $ fromString x)]+cell l x = tell [(LaTeXLI (snd $ L.head $ getCallStack ?loc) l+ ,Cell $ LaTeXLI (snd $ L.head $ getCallStack ?loc) x)]++branch :: Pre => String -> M LaTeXLI () -> M LaTeXLI ()+branch l t = do+ xs <- lift $ nonEmpty =<< execWriterT t+ tell [(LaTeXLI (snd $ L.head $ getCallStack ?loc) l,Condition (Cols 1) xs)]++depth :: TableCells' a b -> Int+depth (Cell _) = 0+depth (Condition (Cols w) xs) = w + maximum (depth.snd <$> xs)++witdth :: TableCells' a b -> Int+witdth (Cell _) = 1+witdth (Condition _ xs) = sum (witdth.snd <$> xs)++columnSpecOf :: TableCells' a b -> [TableSpec]+columnSpecOf t = cols+ where+ d = depth t+ cols = VerticalLine : L.intersperse VerticalLine (replicate d LeftColumn) + ++ [VerticalLine,VerticalLine,CenterColumn,VerticalLine,VerticalLine]++rowToLatex :: Render a => Cols -> Row a -> LaTeX+rowToLatex (Cols size) (Row hs x) = + foldr (&) (rendertex x) (L.map oneHeading hs) + <> lnbk <> cline (n+1) size+ where+ colSpec = [VerticalLine,LeftColumn,VerticalLine]+ oneHeading (Left (Filler (Cols c) _)) + = multicolumn c colSpec ""+ oneHeading (Right (Heading h (Rows r) (Cols c) isLast))+ | isLast = multicolumn (c + (size - total) - 1) (colSpec ++ [VerticalLine]) (multirow r h)+ | otherwise = multicolumn c colSpec (multirow r h)+ canCut x = has (_Right.rows.filtered (<= 1)) x + || has (_Left.isLast.filtered id) x + b = L.dropWhile canCut $ L.reverse hs+ Cols n = sum $ view width <$> b+ Cols total = sum $ view width <$> hs++instance (HasWidth a c,HasWidth b c) => HasWidth (Either a b) c where+ width f (Left x) = Left <$> width f x+ width f (Right x) = Right <$> width f x+instance HasWidth Cols Cols where+ width f x = f x++texFunctionTable :: (Render a,Render b) + => FunctionTable' a b + -> LaTeX+texFunctionTable (Table x t) = tabular Nothing (columnSpecOf t) $ + hline <> + rowToLatex sz (Row cond x) <>+ hline <> + hline <> + (foldMap (rowToLatex sz) . texFunctionTableRows) t+ where+ cond | sz <= 1 = []+ | otherwise = [Right $ Heading "" 1 1 True]+ sz = Cols $ depth t + 1++-- \multirow{number rows}{width}{text}+multirow :: LaTeXC l => Int -> l -> l +multirow n = liftL $ \l -> TeXComm "multirow"+ [ FixArg $ rendertex n+ , FixArg . TeXRaw $ "*"+ , FixArg l+ ]++rows :: Lens' Heading Rows+rows f (Heading l r c b) = (\r' -> Heading l r' c b) <$> f r++cols :: Lens' Heading Cols+cols f (Heading l r c b) = (\c' -> Heading l r c' b) <$> f c++condition :: Rows -> Cols -> LaTeX -> NonEmpty LaTeX+condition (Rows n) (Cols m) t = first :| rest + where+ first = multicolumn m [VerticalLine,CenterColumn,VerticalLine] (multirow n t)+ rest = replicate (n-1) (multicolumn m [VerticalLine,LeftColumn,VerticalLine] "")++makeLast :: Heading -> Heading+makeLast (Heading a b c _) = Heading a b c True++addHeading :: Heading -> Row a -> Row a+addHeading h (Row [] x) = Row [Right $ makeLast h] x+addHeading h (Row hs x) = Row (Right h:hs) x++addMargin :: Cols -> Row a -> Row a+addMargin n (Row hs x) = Row (Left (Filler n False):hs) x++addLastMargin :: Cols -> Row a -> Row a+addLastMargin n (Row hs x) = Row (Left (Filler n True):hs) x++mapNonEmpty :: (a -> b)+ -> ([a] -> [b])+ -> NonEmpty a+ -> NonEmpty b+mapNonEmpty f g (x :| xs) = f x :| g xs++texFunctionTableRows :: Render a + => TableCells' a b+ -> NonEmpty (Row b)+texFunctionTableRows (Cell x) = pure $ Row [] x+texFunctionTableRows (Condition w ts) + = sconcat $ uncurry heading <$> ts+ where+ heading h t = mapNonEmpty + (addHeading h') + (_Snoc %~ bimap (L.map $ addMargin w) (addLastMargin w)) + r+ where+ h' = Heading (rendertex h) (Rows n) w False+ r = texFunctionTableRows t+ n = N.length r++instance Render LaTeXLI where+ render (LaTeXLI _ l) = render $ math $ TeXRaw $ fromString l++instance (Render a,Render b) => Render (FunctionTable' a b) where+ render = render . texFunctionTable
+ test/Spec.hs view
@@ -0,0 +1,5 @@++import Text.LaTeX.FunctionTable++main :: IO ()+main = putStrLn "Test suite not yet implemented"