{-# LANGUAGE CPP #-}
{- |
Module      :  ./Driver/ReadLibDefn.hs
Description :  reading Lib-Defns
Copyright   :  (c) C. Maeder, DFKI 2014
License     :  GPLv2 or higher, see LICENSE.txt

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

reading Lib-Defns for various logics, OWL and CL return several Lib-Defns
-}

module Driver.ReadLibDefn (readLibDefn) where

import Logic.Grothendieck

import Syntax.AS_Library
import Syntax.Parse_AS_Library

import ATC.Sml_cats
import ATC.LibName ()

import CommonLogic.ParseCLAsLibDefn
#ifndef NOOWLLOGIC
import OWL2.ParseOWLAsLibDefn
#endif
#ifdef RDFLOGIC
-- import RDF.ParseRDFAsLibDefn -- MODULE RDF IS BROKEN AT THE MOMENT
#endif
import CSMOF.ParseXmiAsLibDefn
import QVTR.ParseQvtAsLibDefn
import TPTP.ParseAsLibDefn
import FreeCAD.Logic_FreeCAD

import Driver.Options
import Driver.ReadFn

import Common.AnnoState
import Common.Result
import Common.ResultT

import Text.ParserCombinators.Parsec

import Control.Monad.Trans (MonadIO (..))
import qualified Control.Monad.Fail as Fail
import Data.List

mimeTypeMap :: [(String, InType)]
mimeTypeMap :: [(String, InType)]
mimeTypeMap =
  [ ("xml", InType
DgXml)
  , ("html", InType
HtmlIn)
  , ("rdf", OWLFormat -> InType
OWLIn OWLFormat
RdfXml)
  , ("ofn", OWLFormat -> InType
OWLIn OWLFormat
Functional)
  , ("owl", OWLFormat -> InType
OWLIn OWLFormat
OwlXml)
  , ("obo", OWLFormat -> InType
OWLIn OWLFormat
OBO)
  , ("ttl", OWLFormat -> InType
OWLIn OWLFormat
Turtle)
  , ("turtle", OWLFormat -> InType
OWLIn OWLFormat
Turtle)
  , ("omn", OWLFormat -> InType
OWLIn OWLFormat
Manchester)
  , ("dol", InType
DOLIn)
  , ("clif", Bool -> InType
CommonLogicIn Bool
True)
  , ("het", InType
HetCASLIn)
  , ("casl", InType
CASLIn)
  , ("tptp", InType
TPTPIn)
  , ("p", InType
TPTPIn) ]

owlXmlTypes :: [InType]
owlXmlTypes :: [InType]
owlXmlTypes = (OWLFormat -> InType) -> [OWLFormat] -> [InType]
forall a b. (a -> b) -> [a] -> [b]
map OWLFormat -> InType
OWLIn [OWLFormat
OwlXml, OWLFormat
RdfXml, OWLFormat
Turtle]

joinFileTypes :: InType -> InType -> InType
joinFileTypes :: InType -> InType -> InType
joinFileTypes ext :: InType
ext magic :: InType
magic = case (InType
ext, InType
magic) of
  (GuessIn, _) -> InType
magic
  (_, GuessIn) -> InType
ext
  (DgXml, _) | InType -> [InType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem InType
magic [InType]
owlXmlTypes -> InType
magic
  (_, DgXml) | InType -> [InType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem InType
ext [InType]
owlXmlTypes -> InType
ext
  (_, HtmlIn) -> InType
magic
  _ -> InType
ext -- ignore contradictions

findFiletype :: String -> InType
findFiletype :: String -> InType
findFiletype s :: String
s =
  InType
-> ((String, InType) -> InType) -> Maybe (String, InType) -> InType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InType
GuessIn (String, InType) -> InType
forall a b. (a, b) -> b
snd (Maybe (String, InType) -> InType)
-> Maybe (String, InType) -> InType
forall a b. (a -> b) -> a -> b
$ ((String, InType) -> Bool)
-> [(String, InType)] -> Maybe (String, InType)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ (r :: String
r, _) -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf ('/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
r) String
s) [(String, InType)]
mimeTypeMap

guessInput :: (MonadIO m, Fail.MonadFail m) =>
  HetcatsOpts -> Maybe String -> FilePath -> String
  -> m InType
guessInput :: HetcatsOpts -> Maybe String -> String -> String -> m InType
guessInput opts :: HetcatsOpts
opts mr :: Maybe String
mr file :: String
file input :: String
input =
  let fty1 :: InType
fty1 = String -> InType -> InType
guess String
file (HetcatsOpts -> InType
intype HetcatsOpts
opts)
      fty2 :: InType
fty2 = InType -> (String -> InType) -> Maybe String -> InType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InType
GuessIn String -> InType
findFiletype Maybe String
mr
      fty :: InType
fty = InType -> InType -> InType
joinFileTypes InType
fty1 InType
fty2
  in if InType -> [InType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem InType
fty ([InType] -> Bool) -> [InType] -> Bool
forall a b. (a -> b) -> a -> b
$ InType
GuessIn InType -> [InType] -> [InType]
forall a. a -> [a] -> [a]
: InType
DgXml InType -> [InType] -> [InType]
forall a. a -> [a] -> [a]
: [InType]
owlXmlTypes then
    case Bool -> String -> Either String InType
guessXmlContent (InType
fty InType -> InType -> Bool
forall a. Eq a => a -> a -> Bool
== InType
DgXml) String
input of
    Left ty :: String
ty -> String -> m InType
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
ty
    Right ty :: InType
ty -> case InType
ty of
      DgXml -> String -> m InType
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "unexpected DGraph xml"
      _ -> InType -> m InType
forall (m :: * -> *) a. Monad m => a -> m a
return (InType -> m InType) -> InType -> m InType
forall a b. (a -> b) -> a -> b
$ InType -> InType -> InType
joinFileTypes InType
fty InType
ty
  else InType -> m InType
forall (m :: * -> *) a. Monad m => a -> m a
return InType
fty

readLibDefn :: LogicGraph -> HetcatsOpts -> Maybe String
  -> FilePath -> FilePath -> String -> ResultT IO [LIB_DEFN]
readLibDefn :: LogicGraph
-> HetcatsOpts
-> Maybe String
-> String
-> String
-> String
-> ResultT IO [LIB_DEFN]
readLibDefn lgraph :: LogicGraph
lgraph opts :: HetcatsOpts
opts mr :: Maybe String
mr file :: String
file fileForPos :: String
fileForPos input :: String
input =
    if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input then String -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail ("empty input file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) else
    case HetcatsOpts -> InType
intype HetcatsOpts
opts of
    ATermIn _ -> [LIB_DEFN] -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> LIB_DEFN
forall a. ATermConvertibleSML a => String -> a
from_sml_ATermString String
input]
    FreeCADIn ->
      IO [LIB_DEFN] -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [LIB_DEFN] -> ResultT IO [LIB_DEFN])
-> IO [LIB_DEFN] -> ResultT IO [LIB_DEFN]
forall a b. (a -> b) -> a -> b
$ (LIB_DEFN -> [LIB_DEFN]) -> IO LIB_DEFN -> IO [LIB_DEFN]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LIB_DEFN -> [LIB_DEFN] -> [LIB_DEFN]
forall a. a -> [a] -> [a]
: []) (IO LIB_DEFN -> IO [LIB_DEFN])
-> (LibName -> IO LIB_DEFN) -> LibName -> IO [LIB_DEFN]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LibName -> IO LIB_DEFN
readFreeCADLib String
file (LibName -> IO [LIB_DEFN]) -> LibName -> IO [LIB_DEFN]
forall a b. (a -> b) -> a -> b
$ HetcatsOpts -> String -> LibName
fileToLibName HetcatsOpts
opts String
file
    _ -> do
     InType
ty <- HetcatsOpts
-> Maybe String -> String -> String -> ResultT IO InType
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
HetcatsOpts -> Maybe String -> String -> String -> m InType
guessInput HetcatsOpts
opts Maybe String
mr String
file String
input
     case InType
ty of
      HtmlIn -> String -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "unexpected html input"
      CommonLogicIn _ -> String -> HetcatsOpts -> ResultT IO [LIB_DEFN]
parseCL_CLIF String
file HetcatsOpts
opts
#ifdef RDFLOGIC
     -- RDFIn -> liftIO $ parseRDF file
#endif
      Xmi -> [LIB_DEFN] -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> String -> LIB_DEFN
parseXmi String
file String
input]
      Qvt -> IO [LIB_DEFN] -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [LIB_DEFN] -> ResultT IO [LIB_DEFN])
-> IO [LIB_DEFN] -> ResultT IO [LIB_DEFN]
forall a b. (a -> b) -> a -> b
$ (LIB_DEFN -> [LIB_DEFN]) -> IO LIB_DEFN -> IO [LIB_DEFN]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LIB_DEFN -> [LIB_DEFN] -> [LIB_DEFN]
forall a. a -> [a] -> [a]
: []) (IO LIB_DEFN -> IO [LIB_DEFN]) -> IO LIB_DEFN -> IO [LIB_DEFN]
forall a b. (a -> b) -> a -> b
$ String -> String -> IO LIB_DEFN
parseQvt String
file String
input
      TPTPIn -> HetcatsOpts -> String -> String -> ResultT IO [LIB_DEFN]
parseTPTP HetcatsOpts
opts String
file String
input
#ifndef NOOWLLOGIC
      OWLIn _ -> Bool -> String -> ResultT IO [LIB_DEFN]
parseOWLAsLibDefn (HetcatsOpts -> Bool
isStructured HetcatsOpts
opts) String
file
#endif
      _ -> case GenParser Char (AnnoState ()) LIB_DEFN
-> AnnoState () -> String -> String -> Either ParseError LIB_DEFN
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser (LogicGraph -> GenParser Char (AnnoState ()) LIB_DEFN
forall st. LogicGraph -> AParser st LIB_DEFN
library LogicGraph
lgraph { dolOnly :: Bool
dolOnly = Bool
False })
           (() -> AnnoState ()
forall st. st -> AnnoState st
emptyAnnos ()) String
fileForPos String
input of
         Left err :: ParseError
err -> String -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (ParseError -> String
showErr ParseError
err)
         Right ast :: LIB_DEFN
ast -> [LIB_DEFN] -> ResultT IO [LIB_DEFN]
forall (m :: * -> *) a. Monad m => a -> m a
return [LIB_DEFN
ast]