{- |
Module      :  ./OWL2/ParseOWL.hs
Copyright   :  Heng Jiang, Uni Bremen 2004-2007
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable 

analyse OWL files by calling the external Java parser.
-}

module OWL2.ParseOWL (parseOWL, convertOWL) where

import OWL2.AS

import qualified Data.ByteString as BS
import Data.List
import Data.Maybe ()
import qualified Data.Map as Map

import Common.XmlParser
import Common.ProverTools
import Common.Result
import Common.ResultT
import Common.Utils

import Control.Monad
import Control.Monad.Trans
import qualified Control.Monad.Fail as Fail

import OWL2.XML
import OWL2.Rename (unifyDocs)

import System.Directory
import System.Exit
import System.FilePath

import Text.XML.Light hiding (QName)

-- | call for owl parser (env. variable $HETS_OWL_TOOLS muss be defined)
parseOWL :: Bool                  -- ^ Sets Option.quick
         -> FilePath              -- ^ local filepath or uri
         -> ResultT IO (Map.Map String String, [OntologyDocument]) -- ^ map: uri -> OntologyFile
parseOWL :: Bool
-> FilePath
-> ResultT IO (Map FilePath FilePath, [OntologyDocument])
parseOWL quick :: Bool
quick fullFileName :: FilePath
fullFileName = do
    let fn :: FilePath
fn = FilePath -> FilePath -> FilePath
tryToStripPrefix "file://" FilePath
fullFileName
    FilePath
tmpFile <- IO FilePath -> ResultT IO FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FilePath -> ResultT IO FilePath)
-> IO FilePath -> ResultT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO FilePath
getTempFile "" "owlTemp.xml"
    (exitCode :: ExitCode
exitCode, _, errStr :: FilePath
errStr) <- Bool
-> FilePath
-> [FilePath]
-> ResultT IO (ExitCode, FilePath, FilePath)
parseOWLAux Bool
quick FilePath
fn ["-o", "xml", FilePath
tmpFile]
    case (ExitCode
exitCode, FilePath
errStr) of
      (ExitSuccess, "") -> do
          ByteString
cont <- IO ByteString -> ResultT IO ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> ResultT IO ByteString)
-> IO ByteString -> ResultT IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
tmpFile
          IO () -> ResultT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ResultT IO ()) -> IO () -> ResultT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
tmpFile
          ByteString
-> ResultT IO (Map FilePath FilePath, [OntologyDocument])
parseProc ByteString
cont
      _ -> FilePath -> ResultT IO (Map FilePath FilePath, [OntologyDocument])
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Fail.fail (FilePath
 -> ResultT IO (Map FilePath FilePath, [OntologyDocument]))
-> FilePath
-> ResultT IO (Map FilePath FilePath, [OntologyDocument])
forall a b. (a -> b) -> a -> b
$ "process stop! " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows ExitCode
exitCode "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errStr

parseOWLAux :: Bool         -- ^ Sets Option.quick
         -> FilePath        -- ^ local filepath or uri
         -> [String]        -- ^ arguments for java parser
         -> ResultT IO (ExitCode, String, String)
parseOWLAux :: Bool
-> FilePath
-> [FilePath]
-> ResultT IO (ExitCode, FilePath, FilePath)
parseOWLAux quick :: Bool
quick fn :: FilePath
fn args :: [FilePath]
args = do
    let jar :: FilePath
jar = "OWL2Parser.jar"
    (hasJar :: Bool
hasJar, toolPath :: FilePath
toolPath) <- IO (Bool, FilePath) -> ResultT IO (Bool, FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Bool, FilePath) -> ResultT IO (Bool, FilePath))
-> IO (Bool, FilePath) -> ResultT IO (Bool, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Bool, FilePath)
check4HetsOWLjar FilePath
jar
    if Bool
hasJar
      then IO (ExitCode, FilePath, FilePath)
-> ResultT IO (ExitCode, FilePath, FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (ExitCode, FilePath, FilePath)
 -> ResultT IO (ExitCode, FilePath, FilePath))
-> IO (ExitCode, FilePath, FilePath)
-> ResultT IO (ExitCode, FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
executeProcess "java" (["-Djava.util.logging.config.class=JulConfig", "-Dorg.semanticweb.owlapi.model.parameters.ConfigurationOptions.REPORT_STACK_TRACES=false", "-jar", FilePath
toolPath FilePath -> FilePath -> FilePath
</> FilePath
jar]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
args [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
fn] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["-qk" | Bool
quick]) ""
      else FilePath -> ResultT IO (ExitCode, FilePath, FilePath)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Fail.fail (FilePath -> ResultT IO (ExitCode, FilePath, FilePath))
-> FilePath -> ResultT IO (ExitCode, FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
jar
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " not found, check your environment variable: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
hetsOWLenv

-- | converts owl file to desired syntax using owl-api
convertOWL :: FilePath -> String -> IO String
convertOWL :: FilePath -> FilePath -> IO FilePath
convertOWL fn :: FilePath
fn tp :: FilePath
tp = do
  Result ds :: [Diagnosis]
ds mRes :: Maybe (ExitCode, FilePath, FilePath)
mRes <- ResultT IO (ExitCode, FilePath, FilePath)
-> IO (Result (ExitCode, FilePath, FilePath))
forall (m :: * -> *) a. ResultT m a -> m (Result a)
runResultT
    (ResultT IO (ExitCode, FilePath, FilePath)
 -> IO (Result (ExitCode, FilePath, FilePath)))
-> ResultT IO (ExitCode, FilePath, FilePath)
-> IO (Result (ExitCode, FilePath, FilePath))
forall a b. (a -> b) -> a -> b
$ Bool
-> FilePath
-> [FilePath]
-> ResultT IO (ExitCode, FilePath, FilePath)
parseOWLAux Bool
False FilePath
fn ["-o-sys", FilePath
tp]
  case Maybe (ExitCode, FilePath, FilePath)
mRes of
    Just (exitCode :: ExitCode
exitCode, content :: FilePath
content, errStr :: FilePath
errStr) -> case (ExitCode
exitCode, FilePath
errStr) of
      (ExitSuccess, "") -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
content
      _ -> FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ "process stop! " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows ExitCode
exitCode "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errStr
    _ -> FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Int -> [Diagnosis] -> FilePath
showRelDiags 2 [Diagnosis]
ds

parseProc :: BS.ByteString
              -> ResultT IO (Map.Map String String, [OntologyDocument])
parseProc :: ByteString
-> ResultT IO (Map FilePath FilePath, [OntologyDocument])
parseProc str :: ByteString
str = do
  Either FilePath Element
res <- IO (Either FilePath Element)
-> ResultT IO (Either FilePath Element)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either FilePath Element)
 -> ResultT IO (Either FilePath Element))
-> IO (Either FilePath Element)
-> ResultT IO (Either FilePath Element)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (Either FilePath Element)
forall a. XmlParseable a => a -> IO (Either FilePath Element)
parseXml ByteString
str
  case Either FilePath Element
res of
    Left err :: FilePath
err -> FilePath -> ResultT IO (Map FilePath FilePath, [OntologyDocument])
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Fail.fail FilePath
err
    Right el :: Element
el -> let
      es :: [Element]
es = Element -> [Element]
elChildren Element
el
      mis :: [Element]
mis = (Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((QName -> Bool) -> Element -> [Element]
filterElementsName ((QName -> Bool) -> Element -> [Element])
-> (QName -> Bool) -> Element -> [Element]
forall a b. (a -> b) -> a -> b
$ FilePath -> QName -> Bool
isSmth "Missing") [Element]
es
      in do
        Bool -> ResultT IO () -> ResultT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
mis) (ResultT IO () -> ResultT IO ())
-> (FilePath -> ResultT IO ()) -> FilePath -> ResultT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result () -> ResultT IO ()
forall (m :: * -> *) a. MonadResult m => Result a -> m a
liftR (Result () -> ResultT IO ())
-> (FilePath -> Result ()) -> FilePath -> ResultT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> FilePath -> Result ()
forall a. a -> FilePath -> Result a
justWarn () (FilePath -> ResultT IO ()) -> FilePath -> ResultT IO ()
forall a b. (a -> b) -> a -> b
$ "Missing imports: "
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate ", " ((Element -> FilePath) -> [Element] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Element -> FilePath
strContent [Element]
mis)
        (Map FilePath FilePath, [OntologyDocument])
-> ResultT IO (Map FilePath FilePath, [OntologyDocument])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath FilePath
forall k a. Map k a
Map.empty, [OntologyDocument] -> [OntologyDocument]
unifyDocs ([OntologyDocument] -> [OntologyDocument])
-> ([Element] -> [OntologyDocument])
-> [Element]
-> [OntologyDocument]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> OntologyDocument) -> [Element] -> [OntologyDocument]
forall a b. (a -> b) -> [a] -> [b]
map (Map FilePath FilePath -> Element -> OntologyDocument
xmlBasicSpec Map FilePath FilePath
forall k a. Map k a
Map.empty)
                       ([Element] -> [OntologyDocument])
-> [Element] -> [OntologyDocument]
forall a b. (a -> b) -> a -> b
$ (Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((QName -> Bool) -> Element -> [Element]
filterElementsName ((QName -> Bool) -> Element -> [Element])
-> (QName -> Bool) -> Element -> [Element]
forall a b. (a -> b) -> a -> b
$ FilePath -> QName -> Bool
isSmth "Ontology") [Element]
es)