{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.BlogLiterately.Post
(
mkPost, mkArray, postIt, getPostURL, findTitle
) where
import Control.Lens (at, makePrisms, to, traverse,
(^.), (^..), (^?), _Just, _head)
import Data.Char (toLower)
import Data.Function (on)
import Data.List (isInfixOf)
import qualified Data.Map as M
import Network.XmlRpc.Client (remote)
import Network.XmlRpc.Internals (Value (..), XmlRpcType, toValue)
import Text.BlogLiterately.Options
mkPost :: String
-> String
-> [String]
-> [String]
-> Bool
-> [(String, Value)]
mkPost :: String
-> String -> [String] -> [String] -> Bool -> [(String, Value)]
mkPost String
title_ String
text_ [String]
categories_ [String]
tags_ Bool
page_ =
forall a. XmlRpcType [a] => String -> [a] -> [(String, Value)]
mkArray String
"categories" [String]
categories_
forall a. [a] -> [a] -> [a]
++ forall a. XmlRpcType [a] => String -> [a] -> [(String, Value)]
mkArray String
"mt_keywords" [String]
tags_
forall a. [a] -> [a] -> [a]
++ [ (String
"title", forall a. XmlRpcType a => a -> Value
toValue String
title_)
, (String
"description", forall a. XmlRpcType a => a -> Value
toValue String
text_)
]
forall a. [a] -> [a] -> [a]
++ [ (String
"post_type", forall a. XmlRpcType a => a -> Value
toValue String
"page") | Bool
page_ ]
mkArray :: XmlRpcType [a] => String -> [a] -> [(String, Value)]
mkArray :: forall a. XmlRpcType [a] => String -> [a] -> [(String, Value)]
mkArray String
_ [] = []
mkArray String
name [a]
values = [(String
name, forall a. XmlRpcType a => a -> Value
toValue [a]
values)]
makePrisms ''Value
getPostURL :: String -> String -> String -> String -> IO (Maybe String)
getPostURL :: String -> String -> String -> String -> IO (Maybe String)
getPostURL String
url String
pid String
usr String
pwd = do
Value
v <- forall a. Remote a => String -> String -> a
remote String
url String
"metaWeblog.getPost" String
pid String
usr String
pwd
forall (m :: * -> *) a. Monad m => a -> m a
return (Value
v forall s a. s -> Getting (First a) s a -> Maybe a
^? Prism' Value [(String, Value)]
_ValueStruct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at String
"link" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Value String
_ValueString)
findTitle :: Int -> String -> String -> String -> String -> IO (Maybe String)
findTitle :: Int -> String -> String -> String -> String -> IO (Maybe String)
findTitle Int
numPrev String
url String
search String
usr String
pwd = do
Value
res <- forall a. Remote a => String -> String -> a
remote String
url String
"metaWeblog.getRecentPosts" (Int
0::Int) String
usr String
pwd Int
numPrev
let matches :: String -> Bool
matches String
s = (forall a. Eq a => [a] -> [a] -> Bool
isInfixOf forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) String
search String
s
posts :: [Map String Value]
posts = Value
res forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Prism' Value [Value]
_ValueArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Value [(String, Value)]
_ValueStruct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
posts' :: [Map String Value]
posts' = forall a. (a -> Bool) -> [a] -> [a]
filter (\Map String Value
p -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
matches (Map String Value
p forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at String
"title" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Value String
_ValueString)) [Map String Value]
posts
forall (m :: * -> *) a. Monad m => a -> m a
return ([Map String Value]
posts' forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. Cons s s a a => Traversal' s a
_head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at String
"link" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Value String
_ValueString)
postIt :: BlogLiterately -> String -> IO ()
postIt :: BlogLiterately -> String -> IO ()
postIt BlogLiterately
bl String
html =
case (BlogLiterately
blforall s a. s -> Getting a s a -> a
^.Lens' BlogLiterately (Maybe String)
blog, BlogLiterately
blforall s a. s -> Getting a s a -> a
^.Lens' BlogLiterately (Maybe Bool)
htmlOnly) of
(Maybe String
Nothing , Maybe Bool
_ ) -> String -> IO ()
putStr String
html
(Maybe String
_ , Just Bool
True ) -> String -> IO ()
putStr String
html
(Just String
url , Maybe Bool
_ ) -> do
let pwd :: String
pwd = BlogLiterately -> String
password' BlogLiterately
bl
case BlogLiterately
blforall s a. s -> Getting a s a -> a
^.Lens' BlogLiterately (Maybe String)
postid of
Maybe String
Nothing -> do
String
pid <- forall a. Remote a => String -> String -> a
remote String
url String
"metaWeblog.newPost"
(BlogLiterately -> String
blogid' BlogLiterately
bl)
(BlogLiterately -> String
user' BlogLiterately
bl)
String
pwd
[(String, Value)]
post
(BlogLiterately -> Bool
publish' BlogLiterately
bl)
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Post ID: " forall a. [a] -> [a] -> [a]
++ String
pid
String -> String -> String -> String -> IO (Maybe String)
getPostURL String
url String
pid (BlogLiterately -> String
user' BlogLiterately
bl) String
pwd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
putStrLn
Just String
pid -> do
Bool
success <- forall a. Remote a => String -> String -> a
remote String
url String
"metaWeblog.editPost" String
pid
(BlogLiterately -> String
user' BlogLiterately
bl)
String
pwd
[(String, Value)]
post
(BlogLiterately -> Bool
publish' BlogLiterately
bl)
case Bool
success of
Bool
True -> String -> String -> String -> String -> IO (Maybe String)
getPostURL String
url String
pid (BlogLiterately -> String
user' BlogLiterately
bl) String
pwd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
putStrLn
Bool
False -> String -> IO ()
putStrLn String
"Update failed!"
where
post :: [(String, Value)]
post = String
-> String -> [String] -> [String] -> Bool -> [(String, Value)]
mkPost
(BlogLiterately -> String
title' BlogLiterately
bl)
String
html (BlogLiterately
blforall s a. s -> Getting a s a -> a
^.Lens' BlogLiterately [String]
categories) (BlogLiterately
blforall s a. s -> Getting a s a -> a
^.Lens' BlogLiterately [String]
tags)
(BlogLiterately -> Bool
page' BlogLiterately
bl)