packages feed

opml (empty) → 0.4

raw patch · 8 files changed

+564/−0 lines, 8 filesdep +basedep +directorydep +xmlsetup-changed

Dependencies added: base, directory, xml

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Galois, Inc. 2007, 2008++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,7 @@+module Main where++import Distribution.Simple+++main :: IO ()+main = defaultMain
+ Text/OPML/Export.hs view
@@ -0,0 +1,102 @@+--------------------------------------------------------------------+-- |+-- Module    : Text.OPML.Export+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------+--+-- Exporting OPML+--++module Text.OPML.Export where++import Text.XML.Light as XML+import Text.OPML.Syntax++import Data.List+import Data.Maybe++opmlNode :: String -> [XML.Content] -> XML.Element+opmlNode n cs =+  blank_element+    { elName    = opmlName n+    , elContent = cs+    }++opmlName :: String -> QName+opmlName n = QName{qName=n,qURI=Nothing,qPrefix=Nothing}++-- Translate OPML back to XML.+--+xmlOPML :: OPML -> XML.Element+xmlOPML o =+  (opmlNode "opml" $ map Elem $+    (  [ xmlHead (opmlHead o) ]+    ++ [ xmlBody (opmlBody o) ]+    ++ opmlOther o))+    { elAttribs = (Attr (opmlName "version") (opmlVersion o)):opmlAttrs o }++xmlHead :: OPMLHead -> XML.Element+xmlHead h =+  (opmlNode "head" $ map Elem $+      (  [ xmlLeaf "title" (opmlTitle h) ]+      ++ mb (xmlLeaf "dateCreated")  (opmlCreated h)+      ++ mb (xmlLeaf "dateModified") (opmlModified h)+      ++ mb (xmlLeaf "ownerName")    (opmlOwner h >>= opmlOwnerId)+      ++ mb (xmlLeaf "ownerEmail")   (opmlOwner h >>= opmlOwnerEmail)+      ++ mb (xmlLeaf "ownerId")      (opmlOwner h >>= opmlOwnerId)+      ++ mb (xmlLeaf "docs")         (opmlDocs h)+      ++ mb (xmlLeaf "expansionState")  (fmap showInts $ opmlExpansionState h)+      ++ mb (xmlLeaf "vertScrollState") (fmap show $ opmlVertScrollState h)+      ++ mb (xmlLeaf "windowTop") (fmap show $ opmlWindowTop h)+      ++ mb (xmlLeaf "windowLeft") (fmap show $ opmlWindowLeft h)+      ++ mb (xmlLeaf "windowBottom") (fmap show $ opmlWindowBottom h)+      ++ mb (xmlLeaf "windowRight") (fmap show $ opmlWindowRight h)+      ++ opmlHeadOther h))+      { elAttribs = opmlHeadAttrs h}++xmlBody :: [Outline] -> XML.Element+xmlBody os = opmlNode "body" (map (Elem . xmlOutline) os)++xmlOutline :: Outline -> XML.Element+xmlOutline o =+  (opmlNode "outline"+           (map Elem $+             (map xmlOutline (opmlOutlineChildren o) +++              opmlOutlineOther o)))+    { elAttribs =+           [ xmlAttr "text" (opmlText o) ]+        ++ mb (xmlAttr "type") (opmlType o)+        ++ mb (xmlAttr "category") (fmap showCats $ opmlCategories o)+        ++ mb (xmlAttr "isComment") (fmap showBool $ opmlIsComment o)+        ++ mb (xmlAttr "isBreakpoint") (fmap showBool $ opmlIsBreakpoint o)+        ++ opmlOutlineAttrs o}++showCats :: [String] -> String+showCats xs = concat (intersperse "," xs)++showBool :: Bool -> String+showBool True = "true"+showBool _    = "false"++showInts :: [Int] -> String+showInts [] = ""+showInts xs = concat (intersperse "," (map show xs))++xmlAttr :: String -> String -> XML.Attr+xmlAttr k v = Attr (opmlName k) v++xmlLeaf :: String -> String -> XML.Element+xmlLeaf tg txt =+ blank_element{ elName = opmlName tg+              , elContent = [ Text blank_cdata { cdData = txt } ]+              }++---+mb :: (a -> b) -> Maybe a -> [b]+mb _ Nothing = []+mb f (Just x) = [f x]
+ Text/OPML/Import.hs view
@@ -0,0 +1,151 @@+--------------------------------------------------------------------+-- |+-- Module    :  Text.OPML.Import+-- Copyright : (c) Galois, Inc. 2007, 2008+-- License   : BSD3+--+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------+--+-- Import OPML into Haskell.+--++module Text.OPML.Import where++import Text.OPML.Syntax+import Text.XML.Light as XML++import Data.Maybe (listToMaybe, mapMaybe, fromMaybe)+import Data.Char  (isSpace )+import Control.Monad (guard)++-- Access functions++pNodes       :: String -> [XML.Element] -> [XML.Element]+pNodes x es   = filter ((opmlName x ==) . elName) es++pNode        :: String -> [XML.Element] -> Maybe XML.Element+pNode x es    = listToMaybe (pNodes x es)++pLeaf        :: String -> [XML.Element] -> Maybe String+pLeaf x es    = strContent `fmap` pNode x es++pAttr        :: String -> XML.Element -> Maybe String+pAttr x e     = lookup (opmlName x) [ (k,v) | Attr k v <- elAttribs e ]++pMany        :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]+pMany p f es  = mapMaybe f (pNodes p es)++children     :: XML.Element -> [XML.Element]+children e    = onlyElems (elContent e)++opmlName :: String -> QName+opmlName x = QName{qName=x,qURI=Nothing,qPrefix=Nothing}++-- | Parse XML elements into OPML.+elementToOPML :: XML.Element -> Maybe OPML+elementToOPML e =+  do guard (elName e == opmlName "opml")+     let es = children e+     v <- pAttr "version" e+     h <- pNode "head" es >>= elementToHead+     b <- pNode "body" es >>= elementToBody+     let consumed = map opmlName ["head","body"]+     return OPML+       { opmlVersion = v+       , opmlAttrs   = elAttribs e+       , opmlHead    = h+       , opmlBody    = b+       , opmlOther   = filter (\ e1 -> not (elName e1 `elem` consumed)) es+       }++elementToHead :: XML.Element -> Maybe OPMLHead+elementToHead e = do+     guard (elName e == opmlName "head")+     let es = children e+         as = elAttribs e+         knowns = map opmlName+                      [ "title"+                      , "dateCreated"+                      , "dateModified"+                      , "ownerName"+                      , "ownerEmail"+                      , "ownerId"+                      , "docs"+                      , "expansionState"+                      , "vertScrollState"+                      , "windowTop"+                      , "windowLeft"+                      , "windowBottom"+                      , "windowRight"+                      ]+     return OPMLHead+                { opmlTitle     = fromMaybe "" (pLeaf "title" es)+                , opmlHeadAttrs = as+                , opmlCreated   = pLeaf "dateCreated" es+                , opmlModified  = pLeaf "dateModified" es+                , opmlOwner     = Just OPMLOwner+                                    { opmlOwnerId    = pLeaf "ownerId" es+                                    , opmlOwnerEmail = pLeaf "ownerEmail" es+                                    , opmlOwnerName  = pLeaf "ownerName" es+                                    }+                , opmlDocs           = pLeaf "docs" es+                , opmlExpansionState = readInts $ pLeaf "expansionState" es+                , opmlVertScrollState= readInt $ pLeaf "vertScrollState" es+                , opmlWindowTop      = readInt $ pLeaf "windowTop" es+                , opmlWindowLeft     = readInt $ pLeaf "windowLeft" es+                , opmlWindowBottom   = readInt $ pLeaf "windowBottom" es+                , opmlWindowRight    = readInt $ pLeaf "windowRight" es+                , opmlHeadOther      = filter (\ e1 -> not (elName e1 `elem` knowns)) es+                }+ where+  readInts Nothing = Nothing+  readInts (Just xs) =+    case reads xs of+      ((x,_):_) -> Just (x::[Int])+      _ -> Nothing++  readInt Nothing = Nothing+  readInt (Just xs) =+    case reads xs of+      ((x,_):_) -> Just (x::Int)+      _ -> Nothing++elementToBody :: XML.Element -> Maybe [Outline]+elementToBody e = do+     guard (elName e == opmlName "body")+     let es = children e+     return (pMany "outline" elementToOutline es)++elementToOutline :: XML.Element -> Maybe Outline+elementToOutline e = do+     guard (elName e == opmlName "outline")+     let es = children e+     let as = elAttribs e+     let knowns = ["text", "type", "category", "isComment", "isBreakpoint"]+     return Outline+        { opmlText = fromMaybe "" (pAttr "text" e)+        , opmlType = pAttr "type" e+        , opmlCategories = readCats $ pAttr "category" e+        , opmlIsComment = readBool $ pAttr "isComment" e+        , opmlIsBreakpoint = readBool $ pAttr "isBreakpoint" e+        , opmlOutlineAttrs = filter (\ a -> not (qName (attrKey a) `elem` knowns)) as+        , opmlOutlineChildren = pMany "outline" elementToOutline es+        , opmlOutlineOther    = filter (\ e1 -> elName e1 /= opmlName "outline") es+        }+ where+  readCats Nothing = Nothing+  readCats (Just xs) =+    case reads xs of+      ((x,_):_) -> Just (x::[String])+      _ -> Nothing++  readBool Nothing = Nothing+  readBool (Just xs) =+    case dropWhile isSpace xs of+      't':'r':'u':'e':_ -> Just True+      'f':'a':'l':'s':'e':_ -> Just False+      _ -> Nothing+
+ Text/OPML/Reader.hs view
@@ -0,0 +1,80 @@+--------------------------------------------------------------------+-- |+-- Module    : +-- Copyright : (c) Galois, Inc. 2008+-- License   : All rights reserved+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++module Text.OPML.Reader+       ( {- readOPML, -}+         parseOPMLString+       ) where++import Text.OPML.Syntax+import Text.OPML.Import+import Text.XML.Light++{-+import Web.HTTP.Header+import Web.DAV.Utils ( splitURL )+import Web.DAV.Backend.CurlPkg as Curl+import Web.DAV.Backend.Interface+import Web.DAV.Types as WebClient+-}++-- import Data.Maybe ( fromMaybe )++-- | Parse a string into OPML.+parseOPMLString :: String -> Maybe OPML+parseOPMLString str =+  case parseXMLDoc str of+    Nothing -> Nothing+    Just e  -> elementToOPML e+++{-+    +-- remove dependence on webdav++readOPML :: {-URL-}String -> IO (Maybe OPML)+readOPML opmlURL = do+  (st,_,body) <- readIn opmlURL+  case st of+    200 -> +     case parseOPMLString body of+      Nothing -> fail ("readOPML: failed to parse OPML from " ++ opmlURL)+      Just fd -> return (Just fd)+    _ -> return Nothing+ where+  readIn f = do+    catch (readFile f >>= \ ls -> return (200,[],ls))+          (\ _ -> readURL f [])++readURL :: {-URL-}String+        -> [HttpHeader]+        -> IO (Int,[HttpHeader], String)+readURL url hs = do+  let (base,path) = splitURL url+  webH <- primOpen (Curl.factory defaultConfig{cfgOptions=cOpts}) base hs+  st <- WebClient.webGet webH path [] Nothing+  case st of+    WebOK rhs v       -> return (200,rhs,v)+    WebFailed rhs m   -> return (404,rhs,fromMaybe "" m)+    WebStatus rhs v a -> return (v,rhs,a)+ where+  cOpts = cAuthOpts++  cAuthOpts =+        [ CurlHttpAuth [HttpAuthAny]+           -- ToDo: allow cookie file location to be passed in.+        , CurlCookieFile "cookies"+        , CurlCookieJar  "cookies"+        , CurlFollowLocation True+        ]++-}
+ Text/OPML/Syntax.hs view
@@ -0,0 +1,114 @@+--------------------------------------------------------------------+-- |+-- Module    : Text.OPML.Syntax+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------+--+-- OPML syntax definition+--++module Text.OPML.Syntax where++import qualified Text.XML.Light as XML++type DateString = String+type URIString  = String++-- | An OPML structure+data OPML+ = OPML+    { opmlVersion :: String+    , opmlAttrs   :: [XML.Attr]+    , opmlHead    :: OPMLHead+    , opmlBody    :: [Outline]+    , opmlOther   :: [XML.Element]+    }++data Outline+ = Outline+      { opmlText            :: String+      , opmlType            :: Maybe String+      , opmlCategories      :: Maybe [String]+      , opmlIsComment       :: Maybe Bool+      , opmlIsBreakpoint    :: Maybe Bool+      , opmlOutlineAttrs    :: [XML.Attr]+      , opmlOutlineChildren :: [Outline]+      , opmlOutlineOther    :: [XML.Element]+      }++data OPMLHead+ = OPMLHead+       { opmlTitle          :: String+       , opmlHeadAttrs      :: [XML.Attr]+       , opmlCreated        :: Maybe DateString+       , opmlModified       :: Maybe DateString+       , opmlOwner          :: Maybe OPMLOwner+       , opmlDocs           :: Maybe URIString+       , opmlExpansionState :: Maybe [Int]+       , opmlVertScrollState:: Maybe Int+       , opmlWindowTop      :: Maybe Int+       , opmlWindowLeft     :: Maybe Int+       , opmlWindowBottom   :: Maybe Int+       , opmlWindowRight    :: Maybe Int+       , opmlHeadOther      :: [XML.Element]+       }++data OPMLOwner+ = OPMLOwner+       { opmlOwnerId        :: Maybe String+       , opmlOwnerEmail     :: Maybe String+       , opmlOwnerName      :: Maybe String+       }++nullOPML :: OPML+nullOPML =+  OPML { opmlVersion = "2.0"+       , opmlAttrs   = []+       , opmlHead    = nullHead+       , opmlBody    = []+       , opmlOther   = []+       }++nullOutline :: String-> Outline+nullOutline t =+  Outline+      { opmlText            = t+      , opmlType            = Nothing+      , opmlCategories      = Nothing+      , opmlIsComment       = Nothing+      , opmlIsBreakpoint    = Nothing+      , opmlOutlineAttrs    = []+      , opmlOutlineChildren = []+      , opmlOutlineOther    = []+      }++nullHead :: OPMLHead+nullHead+ = OPMLHead+       { opmlTitle           = ""+       , opmlHeadAttrs       = []+       , opmlCreated         = Nothing+       , opmlModified        = Nothing+       , opmlOwner           = Nothing+       , opmlDocs            = Nothing+       , opmlExpansionState  = Nothing+       , opmlVertScrollState = Nothing+       , opmlWindowTop       = Nothing+       , opmlWindowLeft      = Nothing+       , opmlWindowBottom    = Nothing+       , opmlWindowRight     = Nothing+       , opmlHeadOther       = []+       }++nullOwner :: OPMLOwner+nullOwner+ = OPMLOwner+       { opmlOwnerId    = Nothing+       , opmlOwnerEmail = Nothing+       , opmlOwnerName  = Nothing+       }
+ Text/OPML/Writer.hs view
@@ -0,0 +1,48 @@+--------------------------------------------------------------------+-- |+-- Module    : Text.OPML.Writer+-- Copyright : (c) Galois, Inc. 2008+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------+--+-- Writing OPML.+--++module Text.OPML.Writer+       ( -- writeOPML,      -- :: {-URL-}String -> OPML -> IO ()+        serializeOPML  -- :: OPML -> String+       )  where++import Text.OPML.Syntax+import Text.OPML.Export++import Text.XML.Light        ( ppTopElement )++-- import Web.DAV.Client.Curl   ( writeContentsURL )+-- import Data.List  ( isPrefixOf )+-- import System.Directory ( doesFileExist )++{-+writeOPML :: {-URL-}String -> OPML -> IO ()+writeOPML url f = do+  flg <- doesFileExist url+  let str = serializeOPML f+  if flg+   then writeFile url str+   else +     case "http:" `isPrefixOf` url of+       True -> do+        writeContentsURL url str +	return ()+       _ -> writeFile url str+-}++-- | Serialise OPML data back to Strings.+serializeOPML :: OPML -> String+serializeOPML f = ppTopElement $ xmlOPML f+
+ opml.cabal view
@@ -0,0 +1,35 @@+Name:            opml+Version:         0.4+Synopsis:        Representing and handling OPML subscription information.+Description:     +    Representing and handling OPML subscription information.  OPML+    (Outline Processor Markup Language) is an XML format for outlines,+    most commonly used to exchange lists of web feeds between web feed+    aggregators. <http://www.opml.org/>+category:        Text, Web+license:         BSD3+license-file:    LICENSE+author:          Sigbjorn Finne+maintainer:      Don Stewart+copyright:       (c) 2007, 2008 Galois Inc.+Build-type:      Simple+cabal-version:   >= 1.2++flag small_base+    description: Choose the new smaller, split-up base package.++library+    Exposed-modules: +        Text.OPML.Import,+        Text.OPML.Export,+        Text.OPML.Syntax,+        Text.OPML.Reader,+        Text.OPML.Writer++    if flag(small_base)+        build-depends: base >= 3, directory+    else+        build-depends: base < 3++    build-depends:     xml >= 1.2.3+    ghc-options:       -Wall