{- |
Module      :  ./Driver/ReadFn.hs
Description :  reading and parsing ATerms, CASL, DOL files
Copyright   :  (c) Klaus Luettich, C. Maeder, Uni Bremen 2002-2014
License     :  GPLv2 or higher, see LICENSE.txt

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

reading and parsing ATerms, CASL, DOL files as much as is needed for the
static analysis
-}

module Driver.ReadFn
  ( findFileOfLibNameAux
  , libNameToFile
  , fileToLibName
  , readVerbose
  , guessXmlContent
  , isDgXmlFile
  , getContent
  , getExtContent
  , fromShATermString
  , getContentAndFileType
  , showFileType
  , keepOrigClifName
  ) where

import Logic.Grothendieck

import ATC.Grothendieck

import Driver.Options
import Driver.Version

import ATerm.AbstractSyntax
import ATerm.ReadWrite

import Common.Http
import Common.FileType
import Common.Id
import Common.IO
import Common.IRI
import Common.Result
import Common.ResultT
import Common.DocUtils
import Common.LibName
import Common.Utils

import Text.XML.Light

import System.FilePath
import System.Directory

import Data.Char (isSpace)
import Data.List (isPrefixOf)
import Data.Maybe

noPrefix :: QName -> Bool
noPrefix :: QName -> Bool
noPrefix = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> (QName -> Maybe String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Maybe String
qPrefix

isDgXml :: QName -> Bool
isDgXml :: QName -> Bool
isDgXml q :: QName
q = QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "DGraph" Bool -> Bool -> Bool
&& QName -> Bool
noPrefix QName
q

isPpXml :: QName -> Bool
isPpXml :: QName -> Bool
isPpXml q :: QName
q = QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Lib" Bool -> Bool -> Bool
&& QName -> Bool
noPrefix QName
q

isDMU :: QName -> Bool
isDMU :: QName -> Bool
isDMU q :: QName
q = QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "ClashResult" Bool -> Bool -> Bool
&& QName -> Bool
noPrefix QName
q

isRDF :: QName -> Bool
isRDF :: QName -> Bool
isRDF q :: QName
q = QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "RDF" Bool -> Bool -> Bool
&& QName -> Maybe String
qPrefix QName
q Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just "rdf"

isOWLOnto :: QName -> Bool
isOWLOnto :: QName -> Bool
isOWLOnto q :: QName
q = QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Ontology" Bool -> Bool -> Bool
&& QName -> Maybe String
qPrefix QName
q Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just "owl"

guessXmlContent :: Bool -> String -> Either String InType
guessXmlContent :: Bool -> String -> Either String InType
guessXmlContent isXml :: Bool
isXml str :: String
str = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
str of
 '<' : _ -> case String -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc String
str of
  Nothing -> InType -> Either String InType
forall a b. b -> Either a b
Right InType
GuessIn
  Just e :: Element
e -> case Element -> QName
elName Element
e of
    q :: QName
q | QName -> Bool
isDgXml QName
q -> InType -> Either String InType
forall a b. b -> Either a b
Right InType
DgXml
      | QName -> Bool
isRDF QName
q -> InType -> Either String InType
forall a b. b -> Either a b
Right (InType -> Either String InType) -> InType -> Either String InType
forall a b. (a -> b) -> a -> b
$ OWLFormat -> InType
OWLIn (OWLFormat -> InType) -> OWLFormat -> InType
forall a b. (a -> b) -> a -> b
$ if (Element -> Bool) -> [Element] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (QName -> Bool
isOWLOnto (QName -> Bool) -> (Element -> QName) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) ([Element] -> Bool) -> [Element] -> Bool
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e
          then OWLFormat
OwlXml else OWLFormat
RdfXml
      | QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Ontology" -> InType -> Either String InType
forall a b. b -> Either a b
Right (InType -> Either String InType) -> InType -> Either String InType
forall a b. (a -> b) -> a -> b
$ OWLFormat -> InType
OWLIn OWLFormat
OwlXml
      | QName -> Bool
isDMU QName
q -> String -> Either String InType
forall a b. a -> Either a b
Left "unexpected DMU xml format"
      | QName -> Bool
isPpXml QName
q -> String -> Either String InType
forall a b. a -> Either a b
Left "unexpected pp.xml format"
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (QName -> String
qName QName
q) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isXml -> InType -> Either String InType
forall a b. b -> Either a b
Right InType
GuessIn
      | Bool
otherwise -> String -> Either String InType
forall a b. a -> Either a b
Left (String -> Either String InType) -> String -> Either String InType
forall a b. (a -> b) -> a -> b
$ "unknown XML format: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String -> String
tagEnd QName
q ""
 _ -> InType -> Either String InType
forall a b. b -> Either a b
Right InType
GuessIn  -- assume that it is no xml content

isDgXmlFile :: HetcatsOpts -> FilePath -> String -> Bool
isDgXmlFile :: HetcatsOpts -> String -> String -> Bool
isDgXmlFile opts :: HetcatsOpts
opts file :: String
file content :: String
content = String -> InType -> InType
guess String
file (HetcatsOpts -> InType
intype HetcatsOpts
opts) InType -> InType -> Bool
forall a. Eq a => a -> a -> Bool
== InType
DgXml
        Bool -> Bool -> Bool
&& Bool -> String -> Either String InType
guessXmlContent Bool
True String
content Either String InType -> Either String InType -> Bool
forall a. Eq a => a -> a -> Bool
== InType -> Either String InType
forall a b. b -> Either a b
Right InType
DgXml

readShATermFile :: ShATermLG a => LogicGraph -> FilePath -> IO (Result a)
readShATermFile :: LogicGraph -> String -> IO (Result a)
readShATermFile lg :: LogicGraph
lg fp :: String
fp = do
    String
str <- String -> IO String
readFile String
fp
    Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> IO (Result a)) -> Result a -> IO (Result a)
forall a b. (a -> b) -> a -> b
$ LogicGraph -> String -> Result a
forall a. ShATermLG a => LogicGraph -> String -> Result a
fromShATermString LogicGraph
lg String
str

fromVersionedATT :: ShATermLG a => LogicGraph -> ATermTable -> Result a
fromVersionedATT :: LogicGraph -> ATermTable -> Result a
fromVersionedATT lg :: LogicGraph
lg att :: ATermTable
att =
    case ATermTable -> ShATerm
getATerm ATermTable
att of
    ShAAppl "hets" [versionno :: Int
versionno, aterm :: Int
aterm] [] ->
        if String
hetsVersionNumeric String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (ATermTable, String) -> String
forall a b. (a, b) -> b
snd (LogicGraph -> Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermLG t =>
LogicGraph -> Int -> ATermTable -> (ATermTable, t)
fromShATermLG LogicGraph
lg Int
versionno ATermTable
att)
        then [Diagnosis] -> Maybe a -> Result a
forall a. [Diagnosis] -> Maybe a -> Result a
Result [] (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (ATermTable, a) -> a
forall a b. (a, b) -> b
snd ((ATermTable, a) -> a) -> (ATermTable, a) -> a
forall a b. (a -> b) -> a -> b
$ LogicGraph -> Int -> ATermTable -> (ATermTable, a)
forall t.
ShATermLG t =>
LogicGraph -> Int -> ATermTable -> (ATermTable, t)
fromShATermLG LogicGraph
lg Int
aterm ATermTable
att)
        else [Diagnosis] -> Maybe a -> Result a
forall a. [Diagnosis] -> Maybe a -> Result a
Result [DiagKind -> String -> Range -> Diagnosis
Diag DiagKind
Warning
                     "Wrong version number ... re-analyzing"
                     Range
nullRange] Maybe a
forall a. Maybe a
Nothing
    _ -> [Diagnosis] -> Maybe a -> Result a
forall a. [Diagnosis] -> Maybe a -> Result a
Result [DiagKind -> String -> Range -> Diagnosis
Diag DiagKind
Warning
                   "Couldn't convert ShATerm back from ATermTable"
                   Range
nullRange] Maybe a
forall a. Maybe a
Nothing

fromShATermString :: ShATermLG a => LogicGraph -> String -> Result a
fromShATermString :: LogicGraph -> String -> Result a
fromShATermString lg :: LogicGraph
lg str :: String
str = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str then
    [Diagnosis] -> Maybe a -> Result a
forall a. [Diagnosis] -> Maybe a -> Result a
Result [DiagKind -> String -> Range -> Diagnosis
Diag DiagKind
Warning "got empty string from file" Range
nullRange] Maybe a
forall a. Maybe a
Nothing
    else LogicGraph -> ATermTable -> Result a
forall a. ShATermLG a => LogicGraph -> ATermTable -> Result a
fromVersionedATT LogicGraph
lg (ATermTable -> Result a) -> ATermTable -> Result a
forall a b. (a -> b) -> a -> b
$ String -> ATermTable
readATerm String
str

readVerbose :: ShATermLG a => LogicGraph -> HetcatsOpts -> Maybe LibName
  -> FilePath -> IO (Maybe a)
readVerbose :: LogicGraph
-> HetcatsOpts -> Maybe LibName -> String -> IO (Maybe a)
readVerbose lg :: LogicGraph
lg opts :: HetcatsOpts
opts mln :: Maybe LibName
mln file :: String
file = do
    HetcatsOpts -> Int -> String -> IO ()
putIfVerbose HetcatsOpts
opts 2 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Reading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
    Result ds :: [Diagnosis]
ds mgc :: Maybe (LibName, a)
mgc <- LogicGraph -> String -> IO (Result (LibName, a))
forall a. ShATermLG a => LogicGraph -> String -> IO (Result a)
readShATermFile LogicGraph
lg String
file
    HetcatsOpts -> [Diagnosis] -> IO ()
showDiags HetcatsOpts
opts [Diagnosis]
ds
    case Maybe (LibName, a)
mgc of
      Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      Just (ln2 :: LibName
ln2, a :: a
a) -> case Maybe LibName
mln of
        Just ln :: LibName
ln | LibName
ln2 LibName -> LibName -> Bool
forall a. Eq a => a -> a -> Bool
/= LibName
ln -> do
          HetcatsOpts -> Int -> String -> IO ()
putIfVerbose HetcatsOpts
opts 0 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "incompatible library names: "
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ LibName -> String -> String
forall a. Pretty a => a -> String -> String
showDoc LibName
ln " (requested) vs. "
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ LibName -> String -> String
forall a. Pretty a => a -> String -> String
showDoc LibName
ln2 " (found)"
          Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        _ -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | create a file name without suffix from a library name
libNameToFile :: LibName -> FilePath
libNameToFile :: LibName -> String
libNameToFile ln :: LibName
ln = String -> (IRI -> String) -> Maybe IRI -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LibName -> String
libToFileName LibName
ln)
  (String -> String
rmSuffix (String -> String) -> (IRI -> String) -> IRI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> String
iriToStringUnsecure) (Maybe IRI -> String) -> Maybe IRI -> String
forall a b. (a -> b) -> a -> b
$ LibName -> Maybe IRI
locIRI LibName
ln

findFileOfLibNameAux :: HetcatsOpts -> FilePath -> IO (Maybe FilePath)
findFileOfLibNameAux :: HetcatsOpts -> String -> IO (Maybe String)
findFileOfLibNameAux opts :: HetcatsOpts
opts file :: String
file = do
          let fs :: [String]
fs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
</> String
file) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ "" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: HetcatsOpts -> [String]
libdirs HetcatsOpts
opts
          [Maybe String]
ms <- (String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HetcatsOpts -> String -> IO (Maybe String)
existsAnSource HetcatsOpts
opts) [String]
fs
          Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ case [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
ms of
            [] -> Maybe String
forall a. Maybe a
Nothing
            f :: String
f : _ -> String -> Maybe String
forall a. a -> Maybe a
Just String
f

-- | convert a file name that may have a suffix to a library name
fileToLibName :: HetcatsOpts -> FilePath -> LibName
fileToLibName :: HetcatsOpts -> String -> LibName
fileToLibName opts :: HetcatsOpts
opts efile :: String
efile =
    let paths :: [String]
paths = HetcatsOpts -> [String]
libdirs HetcatsOpts
opts
        file :: String
file = String -> String
rmSuffix String
efile -- cut of extension
        pps :: [(String, Bool)]
pps = ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)] -> [(String, Bool)]
forall a b. (a -> b) -> a -> b
$ (String -> (String, Bool)) -> [String] -> [(String, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\ p :: String
p -> (String
p, String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
p String
file)) [String]
paths
    in String -> LibName
emptyLibName (String -> LibName) -> String -> LibName
forall a b. (a -> b) -> a -> b
$ case [(String, Bool)]
pps of
         [] -> if HetcatsOpts -> Bool
useLibPos HetcatsOpts
opts then String -> String
convertFileToLibStr String
file
            else String -> String
mkLibStr String
file
         (path :: String
path, _) : _ -> String -> String
mkLibStr (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path) String
file
                   -- cut off libdir prefix

-- | add query string for an access token before loading an URI
loadAccessUri :: HetcatsOpts -> FilePath -> IO (Either String String)
loadAccessUri :: HetcatsOpts -> String -> IO (Either String String)
loadAccessUri opts :: HetcatsOpts
opts fn :: String
fn = do
  let u :: String
u = String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ case HetcatsOpts -> String
accessToken HetcatsOpts
opts of
        "" -> ""
        t :: String
t -> '?' Char -> String -> String
forall a. a -> [a] -> [a]
: String
accessTokenS String -> String -> String
forall a. [a] -> [a] -> [a]
++ "=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
  HetcatsOpts -> Int -> String -> IO ()
putIfVerbose HetcatsOpts
opts 4 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "downloading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
u
  HetcatsOpts -> String -> IO (Either String String)
loadFromUri HetcatsOpts
opts String
u

downloadSource :: HetcatsOpts -> FilePath -> IO (Either String String)
downloadSource :: HetcatsOpts -> String -> IO (Either String String)
downloadSource opts :: HetcatsOpts
opts fn :: String
fn =
  if String -> Bool
checkUri String
fn then HetcatsOpts -> String -> IO (Either String String)
loadAccessUri HetcatsOpts
opts String
fn else do
    Bool
b <- String -> IO Bool
doesFileExist String
fn
    if Bool
b then Either String String
-> IO (Either String String) -> IO (Either String String)
forall a. a -> IO a -> IO a
catchIOException (String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "could not read file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn)
        (IO (Either String String) -> IO (Either String String))
-> (IO String -> IO (Either String String))
-> IO String
-> IO (Either String String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either String String)
-> IO String -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Either String String
forall a b. b -> Either a b
Right (IO String -> IO (Either String String))
-> IO String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ Enc -> String -> IO String
readEncFile (HetcatsOpts -> Enc
ioEncoding HetcatsOpts
opts) String
fn
      else Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "file does not exist: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn

tryDownload :: HetcatsOpts -> [FilePath] -> FilePath
  -> IO (Either String (FilePath, String))
tryDownload :: HetcatsOpts
-> [String] -> String -> IO (Either String (String, String))
tryDownload opts :: HetcatsOpts
opts fnames :: [String]
fnames fn :: String
fn = case [String]
fnames of
  [] -> Either String (String, String)
-> IO (Either String (String, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (String, String)
 -> IO (Either String (String, String)))
-> Either String (String, String)
-> IO (Either String (String, String))
forall a b. (a -> b) -> a -> b
$ String -> Either String (String, String)
forall a b. a -> Either a b
Left (String -> Either String (String, String))
-> String -> Either String (String, String)
forall a b. (a -> b) -> a -> b
$ "no input found for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn
  fname :: String
fname : fnames' :: [String]
fnames' -> do
       let fname' :: String
fname' = String -> String -> String
tryToStripPrefix "file://" String
fname
       Either String String
mRes <- HetcatsOpts -> String -> IO (Either String String)
downloadSource HetcatsOpts
opts String
fname'
       case Either String String
mRes of
         Left err :: String
err -> do
           Either String (String, String)
eith <- HetcatsOpts
-> [String] -> String -> IO (Either String (String, String))
tryDownload HetcatsOpts
opts [String]
fnames' String
fn
           case Either String (String, String)
eith of
             Left res :: String
res | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fnames' ->
               Either String (String, String)
-> IO (Either String (String, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (String, String)
 -> IO (Either String (String, String)))
-> (String -> Either String (String, String))
-> String
-> IO (Either String (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (String, String)
forall a b. a -> Either a b
Left (String -> IO (Either String (String, String)))
-> String -> IO (Either String (String, String))
forall a b. (a -> b) -> a -> b
$ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
res
             _ -> Either String (String, String)
-> IO (Either String (String, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Either String (String, String)
eith
         Right cont :: String
cont -> Either String (String, String)
-> IO (Either String (String, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (String, String)
 -> IO (Either String (String, String)))
-> Either String (String, String)
-> IO (Either String (String, String))
forall a b. (a -> b) -> a -> b
$ (String, String) -> Either String (String, String)
forall a b. b -> Either a b
Right (String
fname, String
cont)

getContent :: HetcatsOpts -> FilePath
  -> IO (Either String (FilePath, String))
getContent :: HetcatsOpts -> String -> IO (Either String (String, String))
getContent opts :: HetcatsOpts
opts = HetcatsOpts
-> [String] -> String -> IO (Either String (String, String))
getExtContent HetcatsOpts
opts (HetcatsOpts -> [String]
getExtensions HetcatsOpts
opts)

-- URIs must not have queries or fragments as possible extensions are appended
getExtContent :: HetcatsOpts -> [String] -> FilePath
  -> IO (Either String (FilePath, String))
getExtContent :: HetcatsOpts
-> [String] -> String -> IO (Either String (String, String))
getExtContent opts :: HetcatsOpts
opts exts :: [String]
exts fp :: String
fp =
  let fn :: String
fn = String -> String -> String
tryToStripPrefix "file://" String
fp
      fs :: [String]
fs = [String] -> String -> [String]
getFileNames [String]
exts String
fn
      ffs :: [String]
ffs = if String -> Bool
checkUri String
fn Bool -> Bool -> Bool
|| String -> Bool
isAbsolute String
fn then [String]
fs else
           (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ d :: String
d -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
d String -> String -> String
</>) [String]
fs) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ "" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: HetcatsOpts -> [String]
libdirs HetcatsOpts
opts
  in HetcatsOpts
-> [String] -> String -> IO (Either String (String, String))
tryDownload HetcatsOpts
opts [String]
ffs String
fn

{- | output file type, checksum, real file name and file content.
inputs are hets options, optional argument for the file program,
and the library or file name. -}
getContentAndFileType :: HetcatsOpts -> FilePath
  -> IO (Either String (Maybe String, Maybe String, FileInfo, String))
getContentAndFileType :: HetcatsOpts
-> String
-> IO
     (Either String (Maybe String, Maybe String, FileInfo, String))
getContentAndFileType opts :: HetcatsOpts
opts fn :: String
fn = do
  Either String (String, String)
eith <- HetcatsOpts -> String -> IO (Either String (String, String))
getContent HetcatsOpts
opts String
fn
  case Either String (String, String)
eith of
    Left err :: String
err -> Either String (Maybe String, Maybe String, FileInfo, String)
-> IO
     (Either String (Maybe String, Maybe String, FileInfo, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe String, Maybe String, FileInfo, String)
 -> IO
      (Either String (Maybe String, Maybe String, FileInfo, String)))
-> Either String (Maybe String, Maybe String, FileInfo, String)
-> IO
     (Either String (Maybe String, Maybe String, FileInfo, String))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Maybe String, Maybe String, FileInfo, String)
forall a b. a -> Either a b
Left String
err
    Right (nFn :: String
nFn, cont :: String
cont) -> do
      let isUri :: Bool
isUri = String -> Bool
checkUri String
nFn
      String
f <- if Bool
isUri then String -> String -> IO String
getTempFile String
cont "hets-file.tmp" else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
nFn
      Result ds :: [Diagnosis]
ds mr :: Maybe String
mr <- ResultT IO String -> IO (Result String)
forall (m :: * -> *) a. ResultT m a -> m (Result a)
runResultT (ResultT IO String -> IO (Result String))
-> ResultT IO String -> IO (Result String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> ResultT IO String
getMagicFileType (String -> Maybe String
forall a. a -> Maybe a
Just "--mime-type") String
f
      Result es :: [Diagnosis]
es mc :: Maybe String
mc <- ResultT IO String -> IO (Result String)
forall (m :: * -> *) a. ResultT m a -> m (Result a)
runResultT (ResultT IO String -> IO (Result String))
-> ResultT IO String -> IO (Result String)
forall a b. (a -> b) -> a -> b
$ String -> ResultT IO String
getChecksum String
f
      HetcatsOpts -> [Diagnosis] -> IO ()
showDiags HetcatsOpts
opts ([Diagnosis]
ds [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
es)
      let fInfo :: FileInfo
fInfo = FileInfo :: Bool -> String -> FileInfo
FileInfo {
          wasDownloaded :: Bool
wasDownloaded = Bool
isUri,
          filePath :: String
filePath = if Bool
isUri then String
f else String
nFn
        }
      Either String (Maybe String, Maybe String, FileInfo, String)
-> IO
     (Either String (Maybe String, Maybe String, FileInfo, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Maybe String, Maybe String, FileInfo, String)
 -> IO
      (Either String (Maybe String, Maybe String, FileInfo, String)))
-> Either String (Maybe String, Maybe String, FileInfo, String)
-> IO
     (Either String (Maybe String, Maybe String, FileInfo, String))
forall a b. (a -> b) -> a -> b
$ (Maybe String, Maybe String, FileInfo, String)
-> Either String (Maybe String, Maybe String, FileInfo, String)
forall a b. b -> Either a b
Right (Maybe String
mr, Maybe String
mc, FileInfo
fInfo, String
cont)

showFileType :: HetcatsOpts -> FilePath -> IO ()
showFileType :: HetcatsOpts -> String -> IO ()
showFileType opts :: HetcatsOpts
opts fn :: String
fn = do
  Either String (Maybe String, Maybe String, FileInfo, String)
eith <- HetcatsOpts
-> String
-> IO
     (Either String (Maybe String, Maybe String, FileInfo, String))
getContentAndFileType HetcatsOpts
opts String
fn
  case Either String (Maybe String, Maybe String, FileInfo, String)
eith of
    Left err :: String
err -> String -> IO ()
forall a. String -> IO a
hetsIOError String
err
    Right (mr :: Maybe String
mr, _, fInfo :: FileInfo
fInfo, _) ->
      let nFn :: String
nFn = FileInfo -> String
filePath FileInfo
fInfo
          fstr :: String
fstr = (if String
nFn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fn then String
fn else String
nFn String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (via " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")
             String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": "
      in case Maybe String
mr of
        Just s :: String
s -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
fstr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
        Nothing -> String -> IO ()
forall a. String -> IO a
hetsIOError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
fstr String -> String -> String
forall a. [a] -> [a] -> [a]
++ "could not determine file type."

keepOrigClifName :: HetcatsOpts -> FilePath -> FilePath -> FilePath
keepOrigClifName :: HetcatsOpts -> String -> String -> String
keepOrigClifName opts :: HetcatsOpts
opts origName :: String
origName file :: String
file =
  let iTypes :: InType
iTypes = HetcatsOpts -> InType
intype HetcatsOpts
opts
  in case String -> InType -> InType
guess String
file InType
iTypes of
       ext :: InType
ext@(CommonLogicIn _) -> case String -> InType -> InType
guess String
origName InType
iTypes of
         CommonLogicIn _ -> String
origName
         _ -> String
origName String -> String -> String
forall a. [a] -> [a] -> [a]
++ '.' Char -> String -> String
forall a. a -> [a] -> [a]
: InType -> String
forall a. Show a => a -> String
show InType
ext
       _ -> String
file