Skip to content

Commit 2d46849

Browse files
jaspervdjjaspervdj
committed
Initial commit
0 parents  commit 2d46849

File tree

6 files changed

+246
-0
lines changed

6 files changed

+246
-0
lines changed

‎.gitignore

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
dist

‎ChangeLog.md

+5
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
# Revision history for schuif
2+
3+
## 0.1.0.0 -- YYYY-mm-dd
4+
5+
* First version. Released on an unsuspecting world.

‎LICENSE

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
Copyright (c) 2016, Jasper Van der Jeugt
2+
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright
9+
notice, this list of conditions and the following disclaimer.
10+
11+
* Redistributions in binary form must reproduce the above
12+
copyright notice, this list of conditions and the following
13+
disclaimer in the documentation and/or other materials provided
14+
with the distribution.
15+
16+
* Neither the name of Jasper Van der Jeugt nor the names of other
17+
contributors may be used to endorse or promote products derived
18+
from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎Setup.hs

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import Distribution.Simple
2+
main = defaultMain

‎schuif.cabal

+27
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
name: schuif
2+
version: 0.1.0.0
3+
synopsis: Terminal-based pandoc presentation tool
4+
description: Terminal-based pandoc presentation tool
5+
license: BSD3
6+
license-file: LICENSE
7+
author: Jasper Van der Jeugt <[email protected]>
8+
maintainer: Jasper Van der Jeugt <[email protected]>
9+
copyright: 2016 Jasper Van der Jeugt
10+
category: Text
11+
build-type: Simple
12+
extra-source-files: ChangeLog.md
13+
cabal-version: >=1.10
14+
15+
executable schuif
16+
main-is: Main.hs
17+
ghc-options: -Wall
18+
hs-source-dirs: src
19+
default-language: Haskell2010
20+
21+
build-depends:
22+
ansi-wl-pprint >= 0.6 && < 0.7,
23+
ansi-terminal >= 0.6 && < 0.7,
24+
base >= 4.9 && < 4.10,
25+
pandoc >= 1.17 && < 1.18,
26+
terminal-size >= 0.3 && < 0.4
27+
-- other-modules:

‎src/Main.hs

+181
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,181 @@
1+
--------------------------------------------------------------------------------
2+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE RecordWildCards #-}
5+
module Main where
6+
7+
8+
--------------------------------------------------------------------------------
9+
import Data.List (intersperse)
10+
import Data.Monoid ((<>))
11+
import qualified System.Console.ANSI as Ansi
12+
import qualified System.Console.Terminal.Size as Terminal
13+
import System.Environment (getArgs)
14+
import qualified System.IO as IO
15+
import qualified Text.Pandoc as Pandoc
16+
import Text.PrettyPrint.ANSI.Leijen ((<+>))
17+
import qualified Text.PrettyPrint.ANSI.Leijen as PP
18+
19+
20+
--------------------------------------------------------------------------------
21+
data Presentation = Presentation
22+
{ pFilePath :: !FilePath
23+
, pTitle :: ![Pandoc.Inline]
24+
, pAuthor :: ![Pandoc.Inline]
25+
, pSlides :: [Slide]
26+
, pActiveSlide :: !Int
27+
} deriving (Show)
28+
29+
30+
--------------------------------------------------------------------------------
31+
pandocToPresentation :: FilePath -> Pandoc.Pandoc -> Either String Presentation
32+
pandocToPresentation pFilePath pandoc@(Pandoc.Pandoc meta _) = do
33+
let pTitle = Pandoc.docTitle meta
34+
pSlides = pandocToSlides pandoc
35+
pActiveSlide = 0
36+
pAuthor = concat (Pandoc.docAuthors meta)
37+
return Presentation {..}
38+
39+
40+
--------------------------------------------------------------------------------
41+
displayPresentation :: Presentation -> IO ()
42+
displayPresentation Presentation {..} = do
43+
Ansi.clearScreen
44+
Ansi.setCursorPosition 0 0
45+
46+
-- Get terminal width/title
47+
mbWindow <- Terminal.size
48+
let termWidth = maybe 80 Terminal.width mbWindow
49+
termHeight = maybe 10 Terminal.height mbWindow
50+
title = show (prettyInlines pTitle)
51+
titleWidth = length title
52+
titleOffset = (termWidth - titleWidth) `div` 2
53+
54+
Ansi.setCursorColumn titleOffset
55+
PP.putDoc $ PP.yellow $ PP.string title
56+
putStrLn ""
57+
putStrLn ""
58+
59+
let slide = case drop pActiveSlide pSlides of
60+
[] -> mempty
61+
(s : _) -> s
62+
63+
PP.putDoc $ PP.pretty slide
64+
putStrLn ""
65+
66+
let active = show (pActiveSlide + 1) ++ " / " ++ show (length pSlides)
67+
activeWidth = length active
68+
69+
Ansi.setCursorPosition (termHeight - 2) 0
70+
PP.putDoc $ " " <> PP.yellow (prettyInlines pAuthor)
71+
Ansi.setCursorColumn (termWidth - activeWidth - 1)
72+
PP.putDoc $ PP.yellow $ PP.string active
73+
putStrLn ""
74+
75+
76+
--------------------------------------------------------------------------------
77+
updatePresentation :: Char -> Presentation -> Maybe Presentation
78+
79+
updatePresentation char presentation = case char of
80+
'q' -> Nothing
81+
'\n' -> goToSlide nextSlide
82+
'\DEL' -> goToSlide prevSlide
83+
_ -> Just presentation
84+
where
85+
numSlides = length (pSlides presentation)
86+
nextSlide = pActiveSlide presentation + 1
87+
prevSlide = pActiveSlide presentation - 1
88+
89+
goToSlide idx
90+
| idx < numSlides && idx >= 0 = Just presentation {pActiveSlide = idx}
91+
| otherwise = Just presentation
92+
93+
94+
95+
--------------------------------------------------------------------------------
96+
newtype Slide = Slide {unSlide :: [Pandoc.Block]}
97+
deriving (Monoid, Show)
98+
99+
100+
--------------------------------------------------------------------------------
101+
instance PP.Pretty Slide where
102+
pretty = prettyBlocks . unSlide
103+
104+
105+
--------------------------------------------------------------------------------
106+
pandocToSlides :: Pandoc.Pandoc -> [Slide]
107+
pandocToSlides (Pandoc.Pandoc _meta blocks0) = splitSlides blocks0
108+
where
109+
splitSlides blocks = case break (== Pandoc.HorizontalRule) blocks of
110+
(xs, []) -> [Slide xs]
111+
(xs, (_rule : ys)) -> Slide xs : splitSlides ys
112+
113+
114+
--------------------------------------------------------------------------------
115+
prettyBlock :: Pandoc.Block -> PP.Doc
116+
117+
prettyBlock (Pandoc.Para inlines) = prettyInlines inlines
118+
119+
prettyBlock (Pandoc.Header i _ inlines) =
120+
PP.blue $ PP.string (replicate i '#') <+> prettyInlines inlines
121+
122+
prettyBlock (Pandoc.CodeBlock _ txt) = PP.onwhite $ PP.black $ PP.string $
123+
blockify txt
124+
where
125+
blockify str =
126+
let ls = lines str
127+
longest = foldr max 0 (map length ls)
128+
extend l = " " ++ l ++ replicate (longest - length l) ' ' ++ " " in
129+
unlines $ map extend ls
130+
131+
prettyBlock unsupported = PP.onred $ PP.string $ show unsupported
132+
133+
134+
--------------------------------------------------------------------------------
135+
prettyBlocks :: [Pandoc.Block] -> PP.Doc
136+
prettyBlocks = PP.vcat . intersperse "" . map prettyBlock
137+
138+
139+
--------------------------------------------------------------------------------
140+
prettyInline :: Pandoc.Inline -> PP.Doc
141+
142+
prettyInline Pandoc.Space = PP.space
143+
144+
prettyInline (Pandoc.Str str) = PP.string str
145+
146+
prettyInline (Pandoc.Strong inlines) = PP.red $ PP.bold $ prettyInlines inlines
147+
148+
prettyInline (Pandoc.Code _ txt) = PP.onwhite $ PP.black $ PP.string txt
149+
150+
prettyInline (Pandoc.Link _ title (target, _))
151+
| [Pandoc.Str target] == title =
152+
PP.blue $ PP.underline $ "<" <> PP.string target <> ">"
153+
154+
prettyInline Pandoc.SoftBreak = PP.softline
155+
156+
prettyInline unsupported = PP.onred $ PP.string $ show unsupported
157+
158+
159+
--------------------------------------------------------------------------------
160+
prettyInlines :: [Pandoc.Inline] -> PP.Doc
161+
prettyInlines = mconcat . map prettyInline
162+
163+
164+
--------------------------------------------------------------------------------
165+
main :: IO ()
166+
main = do
167+
(file : _) <- getArgs
168+
source <- readFile file
169+
doc <- either (fail . show) return $ Pandoc.readMarkdown Pandoc.def source
170+
pres <- either fail return $ pandocToPresentation file doc
171+
172+
IO.hSetBuffering IO.stdin IO.NoBuffering
173+
loop pres
174+
175+
where
176+
loop pres0 = do
177+
displayPresentation pres0
178+
c <- getChar
179+
case updatePresentation c pres0 of
180+
Nothing -> return ()
181+
Just pres1 -> loop pres1

0 commit comments

Comments
 (0)