extract-last-page.hs

import Data.List

prefixMatch [] _ = True
prefixMatch _ [] = False
prefixMatch (needleHead : needleTail) (strHead : strTail) =
	if needleHead == strHead then prefixMatch needleTail strTail
	else False

findString needle str =
	let findInner cursor index =
		case cursor of
			[] -> Nothing
			(_:cursorTail) -> 
				if prefixMatch needle cursor then Just index
				else findInner cursorTail $ index + 1
	in findInner str 0

splitBy needle str =
	let indexOrNothing = findString needle str
	    needleLength = length needle in
	case indexOrNothing of
		Just index ->
			(take index str) : 
			(splitBy needle . drop (index + needleLength) $ str)
		Nothing ->
			[str]

rewritePageNumber newPage part =
	case findString "\n" part of
		Nothing -> (False, part)
		Just index -> 
			let oldHeader = take index part in
			if oldHeader == ": (atend)" then (False, part)
			else
				let numstr = show newPage in
				(True, concat [": ", numstr, " ", numstr, drop index part])

rewritePageNumbers pages =
	inner pages 1
	where inner pages index =
		case pages of
			[] -> []
			(h : t) ->
				let (success, rewritten) = rewritePageNumber index h in
				if success then rewritten : (inner t $ index + 1)
				else rewritten : (inner t index)

tailN num pages = 
	inner pages []
	where inner pages queue =
		case pages of
			[] -> queue
			(h:t) ->
				let newQueue = case queue of
					(qh:qt) | (length queue) >= 2 -> 
						qt ++ [h]
					q -> q ++ [h]
				in inner t newQueue

main = do
	contents <- getContents
	let pages = splitBy "%%Page" contents
	--let numPages = length pages
	let headIndex = 4
	let tailIndex = 4
	let newPages = rewritePageNumbers (take headIndex pages ++ tailN tailIndex pages)
	putStr . concat . intersperse "%%Page" $ newPages