{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module BDCS.Import.Comps(CompsPkg(..),
CompsGroup(..),
loadFromURI)
where
import Control.Monad.Reader(ReaderT)
import Data.Conduit((.|), runConduitRes)
import qualified Data.Text as T
import Network.URI(URI(..))
import Text.XML(Document, sinkDoc)
import Text.XML.Cursor
import Text.XML.Stream.Parse(def)
import BDCS.Import.Conduit(getFromURI, ungzipIfCompressed)
import BDCS.Import.State(ImportState)
data CompsPkg = CPMandatory T.Text
| CPDefault T.Text
| CPOptional T.Text
| CPUnknown T.Text
| T.Text `CPRequires` T.Text
deriving(Show)
data CompsGroup = CompsGroup T.Text T.Text [CompsPkg]
deriving(Show)
parseCompsPkg :: Cursor -> [CompsPkg]
parseCompsPkg cursor = do
let tys = cursor $| attribute "type"
let names = cursor $/ content
let reqs = cursor $| attribute' "requires"
map toCompsPkg (zip3 tys names reqs)
where
attribute' n c = case attribute n c of
[] -> [""]
x -> x
toCompsPkg ("mandatory", n, _) = CPMandatory n
toCompsPkg ("default", n, _) = CPDefault n
toCompsPkg ("optional", n, _) = CPOptional n
toCompsPkg ("conditional", n, "") = CPUnknown n
toCompsPkg ("conditional", n, r) = n `CPRequires` r
toCompsPkg (_, n, _) = CPUnknown n
parseCompsGroup :: Cursor -> CompsGroup
parseCompsGroup cursor = do
let groupIds = cursor $/ laxElement "id" &/ content
let groupNames = cursor $/ laxElement "name" &/ content
let packages = cursor $// laxElement "packagereq" >=> parseCompsPkg
CompsGroup (head groupIds) (head groupNames) packages
extractGroups :: Document -> [CompsGroup]
extractGroups doc = let
cursor = fromDocument doc
groupCursors = cursor $// laxElement "group"
in
map parseCompsGroup groupCursors
loadFromURI :: URI -> ReaderT ImportState IO ()
loadFromURI uri = do
_groups <- extractGroups <$> runConduitRes (readMetadataPipeline uri)
return ()
where
readMetadataPipeline p = getFromURI p .| ungzipIfCompressed .| sinkDoc def