module Data.Classify.Printer
    ( ppElement
    , applyMarkup
    ) where

import Data.Classify.DataTypes
import Data.Classify.Parser
import Data.Maybe
import Data.List
import Data.Char

buffering :: String -> Int -> String
buffering s len = replicate l '0'++s
    where l = max 0 (len-length s)

ppElement :: String  -- ^ Format
          -> Element -- ^ File structure
          -> String  -- ^ Result
ppElement format element
    = applyMarkup markup layout
    where layout = elementLayout element
          markup = generateMarkup format

-----------------------------
-- Styles
-----------------------------

elementLayout :: Element -> [MarkupLayout]
elementLayout (s@Series {})
    = [Replace 'S' (name s),
       Replace 'E' (title s),
       Replace 'l' (map toLower $ lastname s),
       Function 's' (buffering (show $ season (version s))),
       Function 'e' (buffering (show $ episode (version s)))]

-----------------------------
-- Markup
-----------------------------


applyMarkup :: [MarkupStyle] -> [MarkupLayout] -> String
applyMarkup [] _ = ""
applyMarkup (Literate c:xs) l = c:applyMarkup xs l
applyMarkup (Symbol c:xs) l = s ++ applyMarkup xs l
    where s = fromMaybe "" findReplacement
	  findReplacement = case find findReplace l of
			    Nothing -> Nothing
			    Just (Replace _ s) -> Just s
                            Just (Function _ f) -> Just (f 0)
	      where findReplace (Replace a _) = a==c
                    findReplace (Function a _) = a==c
applyMarkup (Numeric c n:xs) l =numeric ++ applyMarkup xs l
    where numeric = fromMaybe "" findNumeric
	  findNumeric = case find findFunction l of
			Nothing -> Nothing
			Just (Function _ f) -> Just (f n)
	      where findFunction (Function a _) = a==c
		    findFunction _ = False