{-# LANGUAGE CPP #-}
module Network.Gitit.Page ( stringToPage
, pageToString
, readCategories
)
where
import Network.Gitit.Types
import Network.Gitit.Util (trim, splitCategories, parsePageType)
import Text.ParserCombinators.Parsec
import Data.Char (toLower)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.ByteString.UTF8 (toString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import System.IO (withFile, Handle, IOMode(..))
import qualified Control.Exception as E
import System.IO.Error (isEOFError)
parseMetadata :: String -> ([(String, String)], String)
parseMetadata :: [Char] -> ([([Char], [Char])], [Char])
parseMetadata [Char]
raw =
case forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse forall st. GenParser Char st ([([Char], [Char])], [Char])
pMetadataBlock [Char]
"" [Char]
raw of
Left ParseError
_ -> ([], [Char]
raw)
Right ([([Char], [Char])]
ls, [Char]
rest) -> ([([Char], [Char])]
ls, [Char]
rest)
pMetadataBlock :: GenParser Char st ([(String, String)], String)
pMetadataBlock :: forall st. GenParser Char st ([([Char], [Char])], [Char])
pMetadataBlock = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
[Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"---"
Char
_ <- forall st. GenParser Char st Char
pBlankline
[([Char], [Char])]
ls <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall st. GenParser Char st ([Char], [Char])
pMetadataLine forall st. GenParser Char st Char
pMetaEnd
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall st. GenParser Char st Char
pBlankline
[Char]
rest <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char], [Char])]
ls, [Char]
rest)
pMetaEnd :: GenParser Char st Char
pMetaEnd :: forall st. GenParser Char st Char
pMetaEnd = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"..." forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"---"
forall st. GenParser Char st Char
pBlankline
pBlankline :: GenParser Char st Char
pBlankline :: forall st. GenParser Char st Char
pBlankline = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" \t") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
pMetadataLine :: GenParser Char st (String, String)
pMetadataLine :: forall st. GenParser Char st ([Char], [Char])
pMetadataLine = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
Char
first <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
[Char]
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-_")
let ident :: [Char]
ident = Char
firstforall a. a -> [a] -> [a]
:[Char]
rest
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" \t")
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
[Char]
rawval <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n\r"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall st. GenParser Char st Char
pBlankline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" \t") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
' ')
Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
ident, [Char] -> [Char]
trim [Char]
rawval)
stringToPage :: Config -> String -> String -> Page
stringToPage :: Config -> [Char] -> [Char] -> Page
stringToPage Config
conf [Char]
pagename [Char]
raw =
let ([([Char], [Char])]
ls, [Char]
rest) = [Char] -> ([([Char], [Char])], [Char])
parseMetadata [Char]
raw
page' :: Page
page' = Page { pageName :: [Char]
pageName = [Char]
pagename
, pageFormat :: PageType
pageFormat = Config -> PageType
defaultPageType Config
conf
, pageLHS :: Bool
pageLHS = Config -> Bool
defaultLHS Config
conf
, pageTOC :: Bool
pageTOC = Config -> Bool
tableOfContents Config
conf
, pageTitle :: [Char]
pageTitle = [Char]
pagename
, pageCategories :: [[Char]]
pageCategories = []
, pageText :: [Char]
pageText = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r') [Char]
rest
, pageMeta :: [([Char], [Char])]
pageMeta = [([Char], [Char])]
ls }
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Char], [Char]) -> Page -> Page
adjustPage Page
page' [([Char], [Char])]
ls
adjustPage :: (String, String) -> Page -> Page
adjustPage :: ([Char], [Char]) -> Page -> Page
adjustPage ([Char]
"title", [Char]
val) Page
page' = Page
page' { pageTitle :: [Char]
pageTitle = [Char]
val }
adjustPage ([Char]
"format", [Char]
val) Page
page' = Page
page' { pageFormat :: PageType
pageFormat = PageType
pt, pageLHS :: Bool
pageLHS = Bool
lhs }
where (PageType
pt, Bool
lhs) = [Char] -> (PageType, Bool)
parsePageType [Char]
val
adjustPage ([Char]
"toc", [Char]
val) Page
page' = Page
page' {
pageTOC :: Bool
pageTOC = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
val forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"yes",[Char]
"true"] }
adjustPage ([Char]
"categories", [Char]
val) Page
page' =
Page
page' { pageCategories :: [[Char]]
pageCategories = [Char] -> [[Char]]
splitCategories [Char]
val forall a. [a] -> [a] -> [a]
++ Page -> [[Char]]
pageCategories Page
page' }
adjustPage ([Char]
_, [Char]
_) Page
page' = Page
page'
pageToString :: Config -> Page -> String
pageToString :: Config -> Page -> [Char]
pageToString Config
conf Page
page' =
let pagename :: [Char]
pagename = Page -> [Char]
pageName Page
page'
pagetitle :: [Char]
pagetitle = Page -> [Char]
pageTitle Page
page'
pageformat :: PageType
pageformat = Page -> PageType
pageFormat Page
page'
pagelhs :: Bool
pagelhs = Page -> Bool
pageLHS Page
page'
pagetoc :: Bool
pagetoc = Page -> Bool
pageTOC Page
page'
pagecats :: [[Char]]
pagecats = Page -> [[Char]]
pageCategories Page
page'
metadata :: [([Char], [Char])]
metadata = forall a. (a -> Bool) -> [a] -> [a]
filter
(\([Char]
k, [Char]
_) -> Bool -> Bool
not ([Char]
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
[[Char]
"title", [Char]
"format", [Char]
"toc", [Char]
"categories"]))
(Page -> [([Char], [Char])]
pageMeta Page
page')
metadata' :: [Char]
metadata' = (if [Char]
pagename forall a. Eq a => a -> a -> Bool
/= [Char]
pagetitle
then [Char]
"title: " forall a. [a] -> [a] -> [a]
++ [Char]
pagetitle forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
else [Char]
"") forall a. [a] -> [a] -> [a]
++
(if PageType
pageformat forall a. Eq a => a -> a -> Bool
/= Config -> PageType
defaultPageType Config
conf Bool -> Bool -> Bool
||
Bool
pagelhs forall a. Eq a => a -> a -> Bool
/= Config -> Bool
defaultLHS Config
conf
then [Char]
"format: " forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall a. Show a => a -> [Char]
show PageType
pageformat) forall a. [a] -> [a] -> [a]
++
if Bool
pagelhs then [Char]
"+lhs\n" else [Char]
"\n"
else [Char]
"") forall a. [a] -> [a] -> [a]
++
(if Bool
pagetoc forall a. Eq a => a -> a -> Bool
/= Config -> Bool
tableOfContents Config
conf
then [Char]
"toc: " forall a. [a] -> [a] -> [a]
++
(if Bool
pagetoc then [Char]
"yes" else [Char]
"no") forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
else [Char]
"") forall a. [a] -> [a] -> [a]
++
(if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
pagecats)
then [Char]
"categories: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
pagecats forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
else [Char]
"") forall a. [a] -> [a] -> [a]
++
([[Char]] -> [Char]
unlines (forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
k, [Char]
v) -> [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
v) [([Char], [Char])]
metadata))
in (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
metadata' then [Char]
"" else [Char]
"---\n" forall a. [a] -> [a] -> [a]
++ [Char]
metadata' forall a. [a] -> [a] -> [a]
++ [Char]
"...\n\n")
forall a. [a] -> [a] -> [a]
++ Page -> [Char]
pageText Page
page'
readCategories :: FilePath -> IO [String]
readCategories :: [Char] -> IO [[Char]]
readCategories [Char]
f =
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
f IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (do ByteString
fl <- Handle -> IO ByteString
B.hGetLine Handle
h
if ByteString -> Bool
dashline ByteString
fl
then do
[[Char]]
rest <- Handle -> (ByteString -> Bool) -> IO [[Char]]
hGetLinesTill Handle
h ByteString -> Bool
dotOrDashline
let ([([Char], [Char])]
md,[Char]
_) = [Char] -> ([([Char], [Char])], [Char])
parseMetadata forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ [Char]
"---"forall a. a -> [a] -> [a]
:[[Char]]
rest
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
splitCategories forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [Char]
""
forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"categories" [([Char], [Char])]
md
else forall (m :: * -> *) a. Monad m => a -> m a
return [])
(\IOError
e -> if IOError -> Bool
isEOFError IOError
e then forall (m :: * -> *) a. Monad m => a -> m a
return [] else forall e a. Exception e => e -> IO a
E.throwIO IOError
e)
dashline :: B.ByteString -> Bool
dashline :: ByteString -> Bool
dashline ByteString
x =
case ByteString -> [Char]
BC.unpack ByteString
x of
(Char
'-':Char
'-':Char
'-':[Char]
xs) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Char
' ') [Char]
xs -> Bool
True
[Char]
_ -> Bool
False
dotOrDashline :: B.ByteString -> Bool
dotOrDashline :: ByteString -> Bool
dotOrDashline ByteString
x =
case ByteString -> [Char]
BC.unpack ByteString
x of
(Char
'-':Char
'-':Char
'-':[Char]
xs) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Char
' ') [Char]
xs -> Bool
True
(Char
'.':Char
'.':Char
'.':[Char]
xs) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Char
' ') [Char]
xs -> Bool
True
[Char]
_ -> Bool
False
hGetLinesTill :: Handle -> (B.ByteString -> Bool) -> IO [String]
hGetLinesTill :: Handle -> (ByteString -> Bool) -> IO [[Char]]
hGetLinesTill Handle
h ByteString -> Bool
end = do
ByteString
next <- Handle -> IO ByteString
B.hGetLine Handle
h
if ByteString -> Bool
end ByteString
next
then forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString -> [Char]
toString ByteString
next]
else do
[[Char]]
rest <- Handle -> (ByteString -> Bool) -> IO [[Char]]
hGetLinesTill Handle
h ByteString -> Bool
end
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> [Char]
toString ByteString
nextforall a. a -> [a] -> [a]
:[[Char]]
rest)