-----------------------------------------------------------------------------
-- |
-- Module      :  Text.BlogLiterately.Options.Parse
-- Copyright   :  (c) 2013 Brent Yorgey
-- License     :  GPL (see LICENSE)
-- Maintainer  :  Brent Yorgey <byorgey@gmail.com>
--
-- Parsing configuration options from special @[BLOpts]@ blocks.
--
-----------------------------------------------------------------------------

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

--------------------------------------------------
-- Parsing options
--------------------------------------------------

-- | Convert the contents of a @[BLOpts]@ block into an options record
--   and a list of parse errors.
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

-- | Read a single line from a @[BLOpts]@ block.
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
""

-- | Parse a single line from a @[BLOpts]@ block.
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)