Snusmumrik-0.0.1: Book.hs

module Book
       ( Book(..), readBookInfo, unknownBook
       , bookFileName, titleFromFileName ) where

import Data.ByteString.Lazy.Internal (smallChunkSize)
import Data.List (intercalate)
import System.FilePath (makeValid, takeBaseName)
import Text.Regex.TDFA ((=~))

import FB2
import Utils

-- TODO: consider structured author
data Book = Book {
    authors :: [String]
  , title :: String
  , genres :: [String]
  , date :: String
  , lang :: String
  , archive :: String
  , path :: String
  , size :: Int
  } deriving (Eq)

instance Show Book where
  show b = unlines $
    [ (intercalate ", " $ authors b) ++ " /"
    , "  " ++ title b
    , "  " ++ date b
    , "  " ++ (intercalate " " $ genres b)
    , "  lang : " ++ lang b
    , "  in   : " ++ (archive b) ++ " : " ++ (path b)
    ]

unknownBook :: Book
unknownBook = Book {
    authors = []
  , title = ""
  , genres = []
  , date = ""
  , lang = ""
  , archive = ""
  , path = ""
  , size = 0
  }

readBookInfo :: String -> Book
readBookInfo bytes =
  let -- in FB2 all meta data is usually in the beginning,
      -- we don't need to parse everything, smallChunkSize is just a guess (4k)
      -- which seems to work on most of the real-world files
      doc = convParseXml $ take smallChunkSize bytes
      t = getTitle doc
      as = getAuthors doc
      g = getGenres doc
      l = getLang doc
      d = getDate doc
      sz = length bytes
  in  unknownBook { authors = as, title = t, genres = g
                  , lang = l, date = d, size = sz }

-- | Standard template for book files.
bookFileName :: Book -> String
bookFileName book =
  let t = title book
      as = intercalate ", " . filter (not . null) $ authors book
      bookname = takeBaseName $ path book
      year = wrap (" (") (")") (date book)
      wrap b a what | null what = ""
                    | otherwise = b ++ what ++ a
      filename = intercalate " ~ " . filter (not . null)
                 $ [ t, (as ++ year), (bookname ++ ".fb2") ]
  in makeValid . fixname $ filename

-- | Extract title template from filename
titleFromFileName :: String -> String
titleFromFileName n = let (t,_,_) = n =~ " ~ " :: (String,String,String)
                      in  unfixname t