summaryrefslogtreecommitdiff
path: root/hs/Handlingar.hs
blob: 36d1a35b8e1fe3e653b8f5d6e7b2367141a6b775 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
{-# LANGUAGE OverloadedStrings #-}

module Handlingar
( main
) where

import Text.Pandoc
    ( runIOorExplode
    , readVimwiki
    )
import Text.Pandoc.Builder
import Data.Text (Text, pack)
import Text.Show.Pretty (pPrintList)
import System.Environment (getArgs)
import Data.Default (def)


import qualified Data.Text.IO as T


oneOf :: (a -> Bool) -> (a -> Bool) -> a -> Bool
oneOf f g x = f x || g x


-- Find the first heading matching text in the block
findHeading :: Text -> Block -> Bool
findHeading target (Header _ (text, _, _) _) = target == text
findHeading _ _ = False

-- Find the first heading exactly matching level in block
findHeadingByLevel :: Int -> Block -> Bool
findHeadingByLevel target (Header level _ _) = target == level
findHeadingByLevel _ _ = False

-- Find the first horizontal rule tag in block
findHorizontalRule :: Block -> Bool
findHorizontalRule HorizontalRule = True
findHorizontalRule _ = False

-- Return the level of a heading
-- Can only be called on Blocks which are Header's
headingLevel :: Block -> Int
headingLevel (Header level _ _) = level
headingLevel _ = error "Need header"

getHeadingData :: Text -> [Block] -> [Block]
getHeadingData heading blocks =
    let (head:remaining) = dropWhile (not . findHeading heading) blocks
        items = takeWhile (not . (oneOf (findHorizontalRule)
                                        (findHeadingByLevel $ headingLevel head)))
                          remaining
    in head : items


main = do
    args <- getArgs
    case args of
        [file, heading] -> do
            putStrLn $ "Heading = " <> heading
            text <- T.readFile file

            -- html <- handleSourceText text
            pandoc <- runIOorExplode $ readVimwiki def text
            let Pandoc _ blocks = pandoc
            -- putStr . valToStr $ blocks
            pPrintList $ getHeadingData (pack heading) blocks
            -- let htmlString = toStrict . renderHtml $ html
            -- liftIO $ T.writeFile outTarget htmlString
        _ -> error "Invalid command line"