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