Util.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Util where

import Data.Char
import Data.Maybe
import Data.List
import Data.Text(Text(..),pack)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Control.Monad
import Control.Monad.Trans
import System.Environment
import System.FilePath
import System.Exit
import System.Directory
import System.IO
import Text.RegexPR
import Text.Printf

import Web.VKHS.Types
import Web.VKHS.API.Types

{-
 _   _ _   _ _
| | | | |_(_) |___
| | | | __| | / __|
| |_| | |_| | \__ \
 \___/ \__|_|_|___/

 -}

csv_quote :: Text -> Text
csv_quote x = "\"" `Text.append` (Text.replace "\"" "\"\"" x) `Text.append` "\""

pshow :: (Show a) => a -> Text
pshow = Text.pack . show

listTags = intercalate " " . map (\t -> '%' : t : []) . map fst

gr_tags = [
    ('i', show . gr_id)
  , ('m', maybe "?" show . gr_members_count)
  , ('n', namefilter . Text.unpack . gr_name)
  , ('s', namefilter . Text.unpack . gr_screen_name)
  , ('u', groupURL)
  ]

gr_format :: String -> GroupRecord -> String
gr_format s mr = pformat '%' gr_tags s mr

mr_tags = [
    ('i', show . mr_id)
  , ('o', show . mr_owner_id)
  , ('a', namefilter . mr_artist)
  , ('t', namefilter . mr_title)
  , ('d', show . mr_duration)
  , ('u', mr_url_str)
  , ('U', cutextra . mr_url_str)
  ]

mr_format :: String -> MusicRecord -> String
mr_format s mr = pformat '%' mr_tags s mr

pformat :: Char -> [(Char, a->String)] -> String -> a -> String
pformat x d s a = reverse $ scan [] s where
  scan h (c:m:cs)
    | c == x = scan ((reverse $ fromMaybe (const $ c:m:[]) (lookup m d) $ a)++h) cs
    | otherwise = scan (c:h) (m:cs)
  scan h (c:[]) = c:h
  scan h [] = h


trim_space = gsubRegexPR "^ +| +$" ""
one_space = gsubRegexPR " +" " "
normal_letters = filter (\c -> or [ isAlphaNum c , c=='-', c=='_', c==' ', c=='&'])
html_amp = gsubRegexPR "&amp;" "&"
no_html = gsubRegexPR re "" where
  re = concat $ intersperse "|" [ "&[a-z]+;" , "&#[0-9]+;" ]

cutextra = gsubRegexPR "\\?extra=.*" ""

namefilter :: String -> String
namefilter = trim_space . one_space . normal_letters . no_html . html_amp


-- Open file. Return filename and handle. Don't open file if it exists
openFileMR :: MusicOptions -> MusicRecord -> IO (FilePath, Maybe Handle)
openFileMR mo@MusicOptions{..} mr@MusicRecord{..} =
  case m_out_dir of
    Nothing -> do
      let (_,ext) = splitExtension (mr_url_str)
      temp <- getTemporaryDirectory
      (fp,h) <- openBinaryTempFile temp ("vkqmusic"++ext)
      return (fp, Just h)
    Just odir -> do
      let (_,ext) = splitExtension mr_url_str
      let name = mr_format m_output_format mr
      let name' = replaceExtension name (takeWhile (/='?') ext)
      let fp =  (odir </> name')
      e <- doesFileExist fp
      case (e && m_skip_existing) of
        True -> do
          return (fp,Nothing)
        False -> do
          h <- openBinaryFile fp WriteMode
          return (fp,Just h)

io :: (MonadIO m) => IO a -> m a
io = liftIO

printio, printerr :: (MonadIO m) => String -> m ()
printio = liftIO . hPutStrLn stdout
printerr = liftIO . hPutStrLn stderr