diff --git a/IHaskell/Display/Rlangqq.hs b/IHaskell/Display/Rlangqq.hs new file mode 100644 --- /dev/null +++ b/IHaskell/Display/Rlangqq.hs @@ -0,0 +1,108 @@ +{-# OPTIONS_GHC -fno-warn-missing-fields #-} +{-# LANGUAGE TupleSections, TemplateHaskell #-} +module IHaskell.Display.Rlangqq + ( module RlangQQ, + rDisp, + rDisplayAll, + rOutputParsed, + rOutput, + getPlotNames, + getCaptions, + ) where + +import RlangQQ +import RlangQQ.ParseKnitted + +import System.Directory +import System.FilePath +import Data.Maybe +import Data.List +import Text.Read +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as Char +import qualified Data.ByteString.Base64 as Base64 +import IHaskell.Display +import IHaskell.Display.Blaze () -- to confirm it's installed +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as H +import Data.Monoid +import Data.Char +import Control.Monad +import Data.Ord +import Data.List.Split +import Text.XFormat.Show hiding ((<>)) +import Control.Applicative +import Control.Concurrent +import Data.Monoid +import Data.Typeable + +import Control.Concurrent.STM +import Language.Haskell.TH.Quote + +-- | same as 'RlangQQ.r', but displays plots at the end too +rDisp = QuasiQuoter { quoteExp = \s -> [| do + result <- $(quoteExp r s) + p <- rDisplayAll + printDisplay p + return result + |] } + +rOutput :: IO [Int] +rOutput = do + fs <- mapMaybe (readMaybe <=< stripPrefix "raw" <=< stripSuffix ".md") + <$> getDirectoryContents "Rtmp" + fs' <- forM fs $ \f -> (,f) <$> getModificationTime (showf ("Rtmp/raw"%Int%".md") f) + return $ map snd $ sortBy (flip (comparing fst)) fs' + +-- | like 'stripPrefix' except on the end +stripSuffix :: String -> String -> Maybe String +stripSuffix s x = fmap reverse $ stripPrefix (reverse s) $ reverse x + +rOutputParsed :: IO [KnitInteraction] +rOutputParsed = do + ns <- rOutput + case ns of + [] -> return [] + n : _ -> parseKnitted <$> readFile (showf ("Rtmp/raw"%Int%".md") n) + + +getPlotNames :: IO [String] +getPlotNames = do + interactions <- rOutputParsed + return [ p | KnitInteraction _ is <- interactions, KnitImage _ p <- is ] + +getCaptions :: IO [String] +getCaptions = do + interactions <- rOutputParsed + return [ c | KnitInteraction _ is <- interactions, + KnitImage c _ <- is, + not (isBoringCaption c) ] + +-- | true when the caption name looks like one knitr will automatically +-- generate +isBoringCaption :: String -> Bool +isBoringCaption s = maybe False + (all isDigit) + (stripPrefix "plot of chunk unnamed-chunk-" s) + +rDisplayAll :: IO Display +rDisplayAll = do + ns <- rOutputParsed + imgs <- sequence [ displayInteraction o | KnitInteraction _ os <- ns, o <- os] + display (mconcat imgs) + + +displayInteraction :: KnitOutput -> IO Display +displayInteraction (KnitPrint c) = display (plain c) +displayInteraction (KnitWarning c) = display (plain c) +displayInteraction (KnitError c) = display (plain c) +displayInteraction (KnitAsIs c) = display (plain c) +displayInteraction (KnitImage cap img) = do + let caption + | isBoringCaption cap = mempty + | otherwise = H.p (H.toMarkup cap) + encoded <- Base64.encode <$> B.readFile img + display $ H.img H.! H.src (H.unsafeByteStringValue + -- assumes you use the default device which is png + (Char.pack "data:image/png;base64," <> encoded)) + <> caption diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Adam Vogt + +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 Adam Vogt 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/ihaskell-rlangqq.cabal b/ihaskell-rlangqq.cabal new file mode 100644 --- /dev/null +++ b/ihaskell-rlangqq.cabal @@ -0,0 +1,28 @@ +name: ihaskell-rlangqq +version: 0.2.0.0 +synopsis: a rDisp quasiquote to show plots from Rlang-QQ in IHaskell +license: BSD3 +license-file: LICENSE +author: Adam Vogt +maintainer: Adam Vogt +category: Development +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: IHaskell.Display.Rlangqq + other-extensions: TupleSections, TemplateHaskell + build-depends: base <5, + Rlang-QQ >=0.2 && <0.3, + directory >=1.2 && <1.3, + filepath >=1.3 && <1.4, + bytestring >=0.10 && <0.11, + base64-bytestring >=1.0 && <1.1, + ihaskell >=0.5 && <0.6, + ihaskell-blaze >=0.2 && <0.3, + blaze-html >=0.6 && <0.8, + split >=0.2 && <0.3, + stm -any, + xformat >=0.1 && <0.2, + template-haskell >= 2.8 + default-language: Haskell2010