feed2lj-0.0.2: Feed2Lj.hs

-- vim: ts=2 sw=2 expandtab si ai :

import LjPost

import System.Environment (getArgs)
import System.Directory (renameFile)
import Control.Monad (liftM, mapM,ap)
import Maybe (fromJust, isNothing, isJust)
import Network.HTTP (urlEncode)

import Text.Regex.Posix ((=~))

import Network.Curl (curlGetString)
import Text.Feed.Import (parseFeedString)
import Text.Feed.Types (Feed, Item)
import Text.Feed.Query

import IO
import Codec.Binary.UTF8.String (encodeString)

--import Debug.Trace (trace)
--debug x = trace (show x) x

-- take first n sentences from string s
takeSentences n s
  | n > 0     = let (s',r) = takeSentence s
                in s' ++ takeSentences (n-1) r
  | otherwise = ""

takeSentence s =
  let ends = ".?!;"
      (first,rest) = break (`elem` ends) s
  in if not (null rest)
     then (first ++ [head rest],tail rest)
     else (first,[])

-- remove all html/xml tags, quick and dirty
eatTags :: String -> String
eatTags [] = []
eatTags s =
  let (b,t,a) = s =~ "</?[^>]*/?>" :: (String,String,String)
  in b ++ eatTags a

-- mini template engine
renderTemplate _ [] = []
renderTemplate alist s =
  let (b,t,a) = s =~ "%[a-z0-9]*%" :: (String,String,String)
      tagval t
         | t == "%%" = Just "%"
         | otherwise = let inner = take (length t - 2) $ drop 1 t
                       in  lookup inner alist
      val = tagval t
  in if isJust val
       then b ++ (fromJust val) ++ renderTemplate alist a
       else b ++ t ++ renderTemplate alist a

renderItem :: String -> Item -> String
renderItem t i =
  let title = ( fromJust . getItemTitle ) i
      link = ( fromJust . getItemLink ) i
      guid = ( fromJust . getItemId ) i
      summary = ( takeSentences 5 . eatTags . fromJust . getItemSummary) i
      tags = zip [ "title","link","text" ]
                 [ title, urlEncode link,summary ]
  in renderTemplate tags t

isNotSent sent i = ((snd . fromJust . getItemId) i) `notElem` sent

postItem u p t i = do
  let message = renderItem t i
  let subj = fromJust $ getItemTitle i
  r <- postToLj u p subj message
  if isSuccess r
    then putLjKey "url" r
    else putLjKey "errmsg" r

main = do
  url:_ <- getArgs
  (_,rawfeed) <- curlGetString url []

  ljuser <- return fromJust `ap` readLjSetting "username"
  ljpass <- return fromJust `ap` readLjSetting "password"
  sentfile <- return fromJust `ap` readLjSetting "sentfile"
  t <- return fromJust `ap` readLjSetting "template"
  sent_ids <- (return . lines) =<< readFile sentfile

  let feed = fromJust $ parseFeedString rawfeed
  let items = feedItems feed
  let newitems = reverse $ filter (isNotSent sent_ids) items
  let new_ids = map ( snd . fromJust . getItemId) newitems

  mapM_ (postItem ljuser ljpass t) newitems

  renameFile sentfile (sentfile ++ "~")
  writeFile sentfile $ unlines (sent_ids ++ new_ids)