--------------------------------------------------------------------
-- |
-- 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