54 lines
1.4 KiB
Haskell
54 lines
1.4 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{- LANGUAGE OverloadedStrings #-}
|
|
module Article (
|
|
Article(..)
|
|
, at
|
|
) where
|
|
|
|
import Control.Monad.State (evalState, modify, state)
|
|
import System.FilePath (dropExtension)
|
|
import System.Posix.Types (FileID)
|
|
import System.Posix.Files (FileStatus, getFileStatus, fileID)
|
|
|
|
data Article = Article {
|
|
urlPath :: String
|
|
, fileStatus :: FileStatus
|
|
, title :: String
|
|
, preview :: String
|
|
, fullContents :: String
|
|
}
|
|
|
|
getTitle :: [String] -> (String, [String])
|
|
getTitle [] = ("", [])
|
|
getTitle (('#':' ':aTitle):rest) = (aTitle, rest)
|
|
getTitle (a:b:l)
|
|
| length a == length b && (all (== '#') b || all (== '=') b) = (a, b:l)
|
|
| otherwise = getTitle (b:l)
|
|
getTitle (_:rest) = getTitle rest
|
|
|
|
parseBegining :: Int -> String -> (String, String)
|
|
parseBegining linesCount = evalState (do
|
|
theTitle <- state getTitle
|
|
modify $ dropWhile $ not . null
|
|
modify $ dropWhile null
|
|
thePreview <- state $ splitAt linesCount
|
|
return (theTitle, unlines thePreview)
|
|
) . lines
|
|
|
|
at :: Int -> FilePath -> IO (FileID, Article)
|
|
at linesCount filePath = do
|
|
fileStatus <- getFileStatus filePath
|
|
fullContents <- readFile filePath
|
|
let (title, preview) = parseBegining linesCount fullContents
|
|
return (
|
|
fileID fileStatus
|
|
, Article {
|
|
urlPath = dropExtension filePath
|
|
, fileStatus
|
|
, title
|
|
, preview
|
|
, fullContents
|
|
}
|
|
)
|
|
|