module Todos.Parser
(parsePlain, parseAlternate)
where
import Prelude hiding (putStrLn,readFile,getContents,print)
import Data.List
import Text.ParserCombinators.Parsec
import Data.Char
import Todos.Unicode
import Todos.Types
import Todos.Dates
import Todos.Config
type TParser a = GenParser Char BaseConfig a
strip ∷ String → String
strip = reverse ∘ p ∘ reverse ∘ p
where
p = dropWhile isSpace
pSpace ∷ TParser Char
pSpace = oneOf " \t"
pSpace' ∷ TParser String
pSpace' = do
pSpace
return " "
pSpaces ∷ TParser String
pSpaces = many pSpace
pDeps ∷ TParser [String]
pDeps = do
string "("
ws ← (many1 ⋄ noneOf ",)\n\r") `sepBy` (char ',')
string ")"
return $ map strip ws
pTags ∷ TParser [String]
pTags = do
ts ← between (char '[') (char ']') $ word `sepBy1` pSpace
pSpaces
return ts
where
word = many1 (noneOf " \t\n\r]")
pItem ∷ DateTime → TParser TodoItem
pItem date = do
pos ← getPosition
s ← pSpaces
conf ← getState
stat ← if skipStatus conf
then case forcedStatus conf of
Just fs → return fs
Nothing → return "*"
else do
rs ← pWord
case forcedStatus conf of
Just fs → return fs
Nothing → return rs
dates ← (try (pSpecDates date) <|> return [])
tags ← (try pTags <|> return [])
namew ← many1 pWord
pSpaces
deps ← (try pDeps <|> return [])
pSpaces
descr ← many (noneOf "\n\r")
pSpaces
many ⋄ oneOf "\n\r"
return ⋄ Item {
itemLevel = fromIntegral $ length s,
itemName = unwords namew,
itemTags = tags,
depends = deps,
itemStatus = stat,
itemDescr = descr,
startDate = lookup StartDate dates,
endDate = lookup EndDate dates,
deadline = lookup Deadline dates,
fileName = sourceName pos,
lineNr = sourceLine pos }
pWord ∷ TParser String
pWord = do
w ← many1 (noneOf " \t\n\r")
(try pSpace') <|> (return w)
return w
pItems ∷ DateTime → TParser [TodoItem]
pItems date = do
its ← many (pItem date)
eof
return its
unwords' ∷ String → [String] → String
unwords' prefix lst =
let (hd:tl) = map (filter (/='\r')) lst
addLines = filter (not ∘ (prefix `isPrefixOf`)) tl
in case addLines of
[] → hd
_ → hd ⧺ " {" ++ (unwords addLines) ++ "}"
filterN ∷ (Num a, Enum a) ⇒ Int → String → [String] → ([a], [String])
filterN n prefix lst =
let zipped = zip [0..] lst
good = filter (isGood ∘ snd) zipped
lns = map fst good
sub k l = (take l) ∘ (drop k)
ans = map (unwords' prefix) [sub j n lst | j ← lns]
isGood x = prefix `isPrefixOf` x
cut = drop (1+length prefix)
in (map (+1) lns, map cut ans)
filterJoin ∷ Int → String → String → ([Int], String)
filterJoin n prefix str =
let (ns, lns) = filterN n prefix (lines str)
in (ns, unlines lns)
parsePlain ∷ BaseConfig
→ DateTime
→ SourceName
→ String
→ [TodoItem]
parsePlain conf date path text =
case runParser (pItems date) conf path text of
Right items → items
Left e → error $ show e
parseAlternate ∷ BaseConfig
→ Int
→ String
→ DateTime
→ SourceName
→ String
→ [TodoItem]
parseAlternate conf next prefix date path text =
let (ns, filtered) = filterJoin next prefix text
renumber lst = zipWith renumber1 ns lst
renumber1 n item = item {lineNr=n}
in case runParser (pItems date) conf path filtered of
Right items → renumber items
Left e → error $ show e