module Text.BlogLiterately.Options.Parse
( readBLOptions
, readBLOption
, parseBLOption
) where
import Control.Applicative (pure, (*>), (<$>), (<*))
import Control.Arrow (second)
import Control.Lens (ASetter', (&), (.~))
import Data.Char (isSpace)
import Data.Either (partitionEithers)
import Data.Monoid (Monoid, mconcat, mempty)
import Text.Parsec (ParseError, char, many, noneOf,
optional, parse, sepBy, spaces,
string, try, (<|>))
import Text.Parsec.Language (haskell)
import Text.Parsec.String (Parser)
import Text.Parsec.Token (stringLiteral)
import Text.BlogLiterately.Options
readBLOptions :: String -> ([ParseError], BlogLiterately)
readBLOptions :: String -> ([ParseError], BlogLiterately)
readBLOptions = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. Monoid a => [a] -> a
mconcat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> ([a], [b])
partitionEithers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String -> Either ParseError BlogLiterately
readBLOption forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
readBLOption :: String -> Either ParseError BlogLiterately
readBLOption :: String -> Either ParseError BlogLiterately
readBLOption = forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser BlogLiterately
parseBLOption String
""
parseBLOption :: Parser BlogLiterately
parseBLOption :: Parser BlogLiterately
parseBLOption =
forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
style String
"style" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
toc String
"toc" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
rawlatex String
"rawlatex" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
wplatex String
"wplatex" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
math String
"math" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
litHaskell String
"lit-haskell" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
ghci String
"ghci" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
uploadImages String
"upload-images" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately [String]
categories String
"categories" Parser [String]
parseStrList
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately [String]
tags String
"tags" Parser [String]
parseStrList
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
blogid String
"blogid" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
profile String
"profile" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
blog String
"blog" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
user String
"user" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
password String
"password" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
title String
"title" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe String)
postid String
"postid" Parser (Maybe String)
parseStr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
page String
"page" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
publish String
"publish" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately (Maybe Bool)
htmlOnly String
"html-only" Parser (Maybe Bool)
parseBool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField Lens' BlogLiterately [String]
xtra String
"xtras" Parser [String]
parseStrList
str :: Parser String
str :: Parser String
str = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
stringLiteral forall st. TokenParser st
haskell forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
" \t\n\r,\"[]")
parseStr :: Parser (Maybe String)
parseStr :: Parser (Maybe String)
parseStr = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
str
parseBool :: Parser (Maybe Bool)
parseBool :: Parser (Maybe Bool)
parseBool = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ((forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"true" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"on")) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
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 =>
String -> ParsecT s u m String
string String
"false" 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 =>
String -> ParsecT s u m String
string String
"off") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
)
parseStrList :: Parser [String]
parseStrList :: Parser [String]
parseStrList = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
paddedStr forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')
where
paddedStr :: Parser String
paddedStr = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
str forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
parseField :: ASetter' BlogLiterately a -> String -> Parser a -> Parser BlogLiterately
parseField :: forall a.
ASetter' BlogLiterately a
-> String -> Parser a -> Parser BlogLiterately
parseField ASetter' BlogLiterately a
fld String
name Parser a
p = do
String
_ <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name)
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
a
value <- Parser a
p
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& ASetter' BlogLiterately a
fld forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
value)