pgdl-8.0: src/NameAlgo.hs

{-# LANGUAGE OverloadedStrings #-}

module NameAlgo where

import Video

import Data.Function
import Data.Array
import Data.List
import Data.Ord
import Data.Text (Text)
import qualified Data.Text as T

-- | the video name parsing is only for specific type of videos...( [subtitle][video name][episode].... )
-- for most filename, the parsing function will just return the video name itself.
beaut :: Video -> T.Text
beaut (Video str _ _ _) = beautT str
beaut (Folder str _ _)  = beautT str

beautT :: T.Text -> T.Text
beautT str = case cutName str of
    Left x -> "\n" `apd` x
    Right (sbt:nam:eps:_) -> T.unlines  [ ws 4  `apd` sbt
                                        , ws 10 `apd` nam
                                        , ws 30 `apd` eps
                                        ]
    _ -> error "something wrong in video name parsing function"
    where apd = T.append
          ws t = T.replicate t " "

-- | cut the name into pisces
cutName :: T.Text -> Either T.Text [T.Text]
cutName str
    | length dat < 3 = Left str
      -- parsing failure
    | otherwise      = Right [sbtitle, name, episode]
      -- ok.
    where (sbtitle:name:episode:_) = dat
          dat = filter (not . T.null) . getTags ["[", "]"] $ [str]
          getTags :: [T.Text] -> -- ^ the delimiters
                     [T.Text] -> -- ^ initial patterns
                     [T.Text]
          getTags dl s = foldl (\ls d -> concatMap (T.splitOn d) ls) s dl

-- | return the edit distance of two string
editDis :: T.Text -> T.Text -> Int
editDis t1 t2 = dp!(len1, len2)
    where (s1, s2) = (T.unpack t1, T.unpack t2)
          (len1, len2) = (length s1, length s2)
          a1 = listArray (1, len1) s1
          a2 = listArray (1, len2) s2
          bnd = ((0, 0), (len1, len2))
          dp = listArray bnd [go i j | (i, j) <- range bnd]
          go i 0 = i
          go 0 j = j
          go i j = minimum [ dp!(i, j-1) + 1
                           , dp!(i-1, j) + 1
                           , dp!(i-1, j-1) + cost
                           ]
            where cost = if a1!i == a2!j then 0 else 1

-- | caculate whether the edit distance of two video
-- name is less than half of the first video's length
isAlike :: Video -> Video -> Bool
isAlike vf1 vf2 = dis <= lim
    where (n1, n2) = (getName vf1, getName vf2)
          (e1, e2) = (cutName n1, cutName n2)
          vn1 = either id (!!1) e1
          vn2 = either id (!!1) e2
          -- vn1 and vn2 are the video name without subtitle or episode if being parsed.
          lim = length (T.unpack vn1) `div` 2
          dis = editDis vn1 vn2

{-
search :: [Video] ->  -- ^ video list
          [String] -> -- ^ a list of target string
          [Video]
search vids par = filter (\v -> vidInfx v (map T.pack par)) vids
-}

vidInfx :: Video -> [Text] -> Bool
vidInfx _ [] = True
vidInfx v (x:xs) = (x `ifx` getName v) && vidInfx v xs
    where ifx = T.isInfixOf `on` T.toCaseFold

sortByName :: [Video] -> [Video]
sortByName = sortBy (comparing getName)

sortVid :: [Video] -> [Video]
sortVid = sortBy cmpv
    where cmpv :: Video -> Video -> Ordering
          cmpv = cmp `on` dt
            where dt v
                    | isVid v = vidDate v
                    | otherwise = fldDate v
          cmp :: T.Text -> T.Text -> Ordering
          cmp = flip compare `on` prs
            where prs tx = [year, tranMon mon, day, time] 
                    where [day, mon, year, time] = T.splitOn "-" tx
                          tranMon :: T.Text -> T.Text
                          tranMon m = case m of
                            "Jan" -> "A"
                            "Feb" -> "B"
                            "Mar" -> "C"
                            "Apr" -> "D"
                            "May" -> "E"
                            "Jun" -> "F"
                            "Jul" -> "G"
                            "Aug" -> "H"
                            "Sep" -> "I"
                            "Oct" -> "J"
                            "Nov" -> "K"
                            "Dec" -> "L"
                            _     -> " "