xmltv (empty) → 0.0.1
raw patch · 8 files changed
+332/−0 lines, 8 filesdep +basedep +bytestringdep +configuratorsetup-changed
Dependencies added: base, bytestring, configurator, filepath, http-client, network-uri, old-locale, split, terminfo, time, unix, wl-pprint-extras, wl-pprint-terminfo, xdg-basedir, xml
Files
- LICENSE +21/−0
- README.md +6/−0
- Setup.hs +2/−0
- man/tv.1 +44/−0
- src/Text/XmlTv.hs +103/−0
- src/Tv.hs +105/−0
- tv.cfg.example +8/−0
- xmltv.cabal +43/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 Per Odlund++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ README.md view
@@ -0,0 +1,6 @@+hs-xmltv+========++small tool for parsing xmltv files++check out the [homepage](http://alephnull.se/software/hs-xmltv) for more info
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ man/tv.1 view
@@ -0,0 +1,44 @@+.TH TV 1+.SH NAME+tv \- display whats on tv+.SH SYNOPSIS+.B tv+[+.I options+]+.SH DESCRIPTION+.B tv+is a commandline tool for showing whats on tv. tv uses the XmlTV format for parsing+and requires an url for the channel database. tv support both commandline option or using a config file+.PP+tv will display all selected channels or if no channels are selected, all channels form the channels db.+.SH OPTIONS+.TP+.B -u url +Path to the channels db file.+.TP+.B -w min-width+Minimum length of a program name.+.TP+.B -t relative time+Set the day in relative, -1 for yesterday and 1 for tomorrow (default: today).+.TP+.B -c [channels]+Channels to list, an empty list equals all channels (default: all channels).+.SH CONFIG SYNTAX+url = string+.br+channels = [strings] +.br+min-width = int+.br+show-trailing = bool+.br+sort-channels = bool+.br+show-aired = bool++.SH AUTHOR+Per Odlund+.SH SOURCE+https://github.com/dagle/hs-xmltv
+ src/Text/XmlTv.hs view
@@ -0,0 +1,103 @@+module Text.XmlTv (+ Channel(..)+ , Program(..)+ , xmlToChannel+ , xmlToProgram+ , parseChannels+ , parsePrograms+ , filterChans+ , updateChannel+ , findChan+ , sortChans+ , previous+ , current+ , later+) where++import Control.Monad+import Data.Maybe+import Text.XML.Light+import Data.Time+import System.Locale++data Channel = Channel {+ cid :: String+ , lang :: String+ , name :: String+ , base :: String+ , programs :: [Program]+} deriving (Show, Eq)++data Program = Program {+ start :: UTCTime+ , stop :: UTCTime+ , title :: String+ , description :: String+} deriving (Show, Eq)++toDate :: String -> Maybe UTCTime+toDate str = parseTime defaultTimeLocale "%Y%m%d%H%M%S %z" str++previous, current, later :: Program -> UTCTime -> Bool+previous (Program start stop _ _) now = diffUTCTime start now < 0 && diffUTCTime stop now < 0+current (Program start stop _ _) now = diffUTCTime start now < 0 && diffUTCTime stop now > 0+later (Program start stop _ _) now = diffUTCTime start now > 0 && diffUTCTime stop now > 0++xmlToChannel :: Element -> Maybe Channel+xmlToChannel e = do+ id <- findAttr (QName "id" Nothing Nothing) e+ d <- findChild (QName "display-name" Nothing Nothing) e+ lang <- findAttr (QName "lang" Nothing Nothing) d+ title <- listToMaybe . map cdData . onlyText . elContent $ d+ b <- findChild (QName "base-url" Nothing Nothing) e+ base <- listToMaybe . map cdData . onlyText . elContent $ b+ return $ Channel id lang title base []++-- A lot of optional fields that we should parse+xmlToProgram :: Element -> Maybe Program+xmlToProgram e = do+ start <- findAttr (QName "start" Nothing Nothing) e >>= toDate+ stop <- findAttr (QName "stop" Nothing Nothing) e >>= toDate+ t <- findChild (QName "title" Nothing Nothing) e+ --d <- findChild (QName "desc" Nothing Nothing) e+ title <- listToMaybe . map cdData . onlyText . elContent $ t+ --desc <- listToMaybe . map cdData . onlyText . elContent $ d+ return (Program start stop title "")++parseChannels :: String -> [Maybe Channel]+parseChannels str = do+ case parseXMLDoc str of+ Just p -> + let f = findElements (QName "channel" Nothing Nothing) p+ in map xmlToChannel f+ Nothing -> []++parsePrograms :: String -> [Maybe Program]+parsePrograms str = do+ case parseXMLDoc str of+ Just p -> + let f = findElements (QName "programme" Nothing Nothing) p+ in map xmlToProgram f+ Nothing -> []++-- Starts of by filtering empty channels and then applies another filter.+filterChans :: (Channel -> Bool) -> [Maybe Channel] -> [Channel]+filterChans f chans = + let pure = catMaybes chans+ in filter f pure++sortChans :: [String] -> [Channel] -> [Channel]+sortChans strs chans =+ map (findChan chans) strs++findChan :: [Channel] -> String -> Channel+findChan chans str = + head . filter ((==) str . name) $ chans+-- takes a channel, a prefix and a fetch method;+-- then etches all programs for that channel using prefix+-- (often date).+updateChannel :: String -> (String -> IO String) -> Channel -> IO Channel+updateChannel prefix fetch c = do+ let url = base c ++ cid c ++ prefix + tv <- liftM (catMaybes . parsePrograms) . fetch $ url+ return c { programs = (programs c) ++ tv}
+ src/Tv.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++import Data.Time.LocalTime+import Data.Time.Clock+import Data.Maybe+import Control.Monad+import System.Environment+import qualified Data.Configurator as CFG+import Data.Configurator.Types+import Format+import System.Console.Terminfo.PrettyPrint+import Data.Time.Calendar+import Data.Time.Clock+import System.Console.GetOpt+import Text.Read++getHomoList :: Config -> Name -> IO (Maybe [String])+getHomoList cfg str = do+ r <- CFG.lookup cfg str+ case r of+ (Just (List v)) -> return $ helper v+ _ -> return $ Nothing+ where+ helper values =+ let vs = map convert values :: [Maybe String]+ homo = foldr (\x y -> y && isJust x) True vs+ in if homo+ then Just $ map fromJust vs+ else Nothing ++addDaysTime :: Integer -> UTCTime -> UTCTime+addDaysTime i (UTCTime day t) =+ let dday = addDays i day+ in UTCTime dday t++-- can't we do this better, also missing colors+str2color :: String -> TermDoc -> TermDoc+str2color str+ | str == "white" = white+ | str == "red" = red+ | str == "magenta" = magenta++getColors :: Config -> Name -> IO (Coloring, Coloring, Coloring, Coloring)+getColors cfg name = do+ s <- CFG.lookup cfg name+ case s of+ Nothing -> return (white, red, magenta, white)+ (Just (a,b,c,d)) -> return (str2color a, str2color b, str2color c, str2color d)++getConfig :: [Worth FilePath] -> IO XmlTvPP+getConfig paths = do+ cfg <- CFG.load paths+ url <- liftM (fromMaybe "") $ CFG.lookup cfg "url"+ chans <- liftM (fromMaybe []) $ getHomoList cfg "channels" + minWidth <- liftM (fromMaybe 20) $ CFG.lookup cfg "min-width"+ colors <- getColors cfg "colors"+ yester <- liftM (fromMaybe False) $ CFG.lookup cfg "show-trailing"+ sort <- liftM (fromMaybe True) $ CFG.lookup cfg "sort-channels"+ showAired <- liftM (fromMaybe True) $ CFG.lookup cfg "show-aired"+ width <- getCols+ tz <- getCurrentTimeZone+ current <- getCurrentTime+ return $ XmlTvPP url chans tz current width minWidth colors yester sort showAired True++readpos :: String -> Int+readpos str =+ let i = read str+ in if i >= 0 then i else error "negative number"++parseChannels :: String -> [String]+parseChannels str =+ case readMaybe str of+ (Just c) -> c+ Nothing -> [str]++options :: [OptDescr (XmlTvPP -> XmlTvPP)]+options =+ [ Option ['t'] ["time"]+ (ReqArg (\d cfg -> cfg { currentTime = addDaysTime (read d) (currentTime cfg)+ , today = (read d) == 0}) "relative day")+ "relative day, -1,2,+1"+ , Option ['c'] ["channel"]+ (ReqArg (\c cfg -> cfg { channels = parseChannels c}) "channels")+ "channels you want to display"+ , Option ['w'] ["width"]+ (ReqArg (\w cfg -> cfg { minWidth = readpos w }) "width")+ "Min width of channel"+ , Option ['u'] ["url"]+ (ReqArg (\u cfg -> cfg { url = u }) "xmltv url")+ "url to the xmltv"+ ]++parseArgs :: XmlTvPP -> [String] -> IO (XmlTvPP, [String])+parseArgs cfg args =+ case getOpt Permute options args of+ (o,n,[]) -> return (foldl (flip id) cfg o, n)+ (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+ where header = "Usage: tv [OPTION...]"++main :: IO ()+main = do+ args <- getArgs+ cfg <- getConfig ["$(HOME)/.config/tv/tv.cfg"]+ (parsed, _) <- parseArgs cfg args+ showTvDay parsed
+ tv.cfg.example view
@@ -0,0 +1,8 @@+url = "http://tv.swedb.se/xmltv/channels.xml.gz"+channels = ["SVT 1", "SVT 2"]+# header, past, current, and future+colors = ("white", "red", "magenta", "white")+min-width = 20+show-trailing = true+sort-channels = true+show-aired = true
+ xmltv.cabal view
@@ -0,0 +1,43 @@+name: xmltv+version: 0.0.1+synopsis: Show tv channels in the terminal+license: MIT+license-file: LICENSE+author: Per Odlund+maintainer: per.odlund@gmail.com+category: System+build-type: Simple+cabal-version: >=1.10+homepage: http://github.com/dagle/hs-xmltv+data-files: man/tv.1+extra-source-files: README.md,+ tv.cfg.example+ man/tv.1++description:+ A program for showing whats on tv in the terminal using xmltv.+ Comes with a lib and a program to fetch and prettyprint the info.++library+ default-language: Haskell2010+ build-depends: base > 3 && < 5, time, old-locale, xml+ hs-source-dirs: src+ exposed-modules: Text.XmlTv+ ghc-options: -funbox-strict-fields -rtsopts+ ghc-prof-options: -auto-all+++executable tv+ default-language: Haskell2010+ build-depends: base > 3, xml, bytestring, time,+ terminfo, wl-pprint-terminfo, old-locale, wl-pprint-extras, + configurator, filepath, xdg-basedir, http-client, network-uri, + unix, split+ hs-source-dirs: src + main-is: Tv.hs+ ghc-options: -rtsopts+ ghc-prof-options: -auto-all++source-repository head+ type: git+ location: git://github.com/dagle/hs-xmltv.git