module GF.Command.Importing (importGrammar, importSource) where

import PGF
import PGF.Internal(optimizePGF,unionPGF,msgUnionPGF)

import GF.Compile
import GF.Compile.Multi (readMulti)
import GF.Compile.GetGrammar (getBNFCRules, getEBNFRules)
import GF.Grammar (SourceGrammar) -- for cc command
import GF.Grammar.BNFC
import GF.Grammar.EBNF
import GF.Grammar.CFG
import GF.Compile.CFGtoPGF
import GF.Infra.UseIO(die,tryIOE)
import GF.Infra.Option
import GF.Data.ErrM

import System.FilePath
import qualified Data.Set as Set

-- import a grammar in an environment where it extends an existing grammar
importGrammar :: PGF -> Options -> [FilePath] -> IO PGF
importGrammar :: PGF -> Options -> [FilePath] -> IO PGF
importGrammar PGF
pgf0 Options
_ [] = PGF -> IO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return PGF
pgf0
importGrammar PGF
pgf0 Options
opts [FilePath]
files =
  case FilePath -> FilePath
takeExtensions ([FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
files) of
    FilePath
".cf"   -> Options
-> [FilePath]
-> (Options -> FilePath -> IO [BNFCRule])
-> ([BNFCRule] -> [Rule (FilePath, [Param]) FilePath])
-> IO PGF
forall a.
Options
-> [FilePath]
-> (Options -> FilePath -> IO [a])
-> ([a] -> [Rule (FilePath, [Param]) FilePath])
-> IO PGF
importCF Options
opts [FilePath]
files Options -> FilePath -> IO [BNFCRule]
getBNFCRules [BNFCRule] -> [Rule (FilePath, [Param]) FilePath]
bnfc2cf
    FilePath
".ebnf" -> Options
-> [FilePath]
-> (Options -> FilePath -> IO [ERule])
-> ([ERule] -> [Rule (FilePath, [Param]) FilePath])
-> IO PGF
forall a.
Options
-> [FilePath]
-> (Options -> FilePath -> IO [a])
-> ([a] -> [Rule (FilePath, [Param]) FilePath])
-> IO PGF
importCF Options
opts [FilePath]
files Options -> FilePath -> IO [ERule]
getEBNFRules [ERule] -> [Rule (FilePath, [Param]) FilePath]
ebnf2cf
    FilePath
".gfm"  -> do
      [(FilePath, [FilePath])]
ascss <- (FilePath -> IO (FilePath, [FilePath]))
-> [FilePath] -> IO [(FilePath, [FilePath])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (FilePath, [FilePath])
readMulti [FilePath]
files
      let cs :: [FilePath]
cs = ((FilePath, [FilePath]) -> [FilePath])
-> [(FilePath, [FilePath])] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath, [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd [(FilePath, [FilePath])]
ascss
      PGF -> Options -> [FilePath] -> IO PGF
importGrammar PGF
pgf0 Options
opts [FilePath]
cs
    FilePath
s | FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
s [FilePath
".gf",FilePath
".gfo"] -> do
      Err PGF
res <- IO PGF -> IO (Err PGF)
forall a. IOE a -> IO (Err a)
tryIOE (IO PGF -> IO (Err PGF)) -> IO PGF -> IO (Err PGF)
forall a b. (a -> b) -> a -> b
$ Options -> [FilePath] -> IO PGF
compileToPGF Options
opts [FilePath]
files
      case Err PGF
res of
        Ok PGF
pgf2 -> PGF -> PGF -> IO PGF
ioUnionPGF PGF
pgf0 PGF
pgf2
        Bad FilePath
msg -> do FilePath -> IO ()
putStrLn (Char
'\n'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\n'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
msg)
                      PGF -> IO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return PGF
pgf0
    FilePath
".pgf" -> do
      PGF
pgf2 <- (FilePath -> IO PGF) -> [FilePath] -> IO [PGF]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO PGF
readPGF [FilePath]
files IO [PGF] -> ([PGF] -> IO PGF) -> IO PGF
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PGF -> IO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return (PGF -> IO PGF) -> ([PGF] -> PGF) -> [PGF] -> IO PGF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGF -> PGF -> PGF) -> [PGF] -> PGF
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 PGF -> PGF -> PGF
unionPGF
      PGF -> PGF -> IO PGF
ioUnionPGF PGF
pgf0 PGF
pgf2
    FilePath
ext -> FilePath -> IO PGF
forall a. FilePath -> IO a
die (FilePath -> IO PGF) -> FilePath -> IO PGF
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown filename extension: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
ext

ioUnionPGF :: PGF -> PGF -> IO PGF
ioUnionPGF :: PGF -> PGF -> IO PGF
ioUnionPGF PGF
one PGF
two = case PGF -> PGF -> (PGF, Maybe FilePath)
msgUnionPGF PGF
one PGF
two of
  (PGF
pgf, Just FilePath
msg) -> FilePath -> IO ()
putStrLn FilePath
msg IO () -> IO PGF -> IO PGF
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PGF -> IO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return PGF
pgf
  (PGF
pgf,Maybe FilePath
_)         -> PGF -> IO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return PGF
pgf

importSource :: Options -> [FilePath] -> IO SourceGrammar
importSource :: Options -> [FilePath] -> IO SourceGrammar
importSource Options
opts [FilePath]
files = ((UTCTime, (ModuleName, SourceGrammar)) -> SourceGrammar)
-> IO (UTCTime, (ModuleName, SourceGrammar)) -> IO SourceGrammar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ModuleName, SourceGrammar) -> SourceGrammar
forall a b. (a, b) -> b
snd((ModuleName, SourceGrammar) -> SourceGrammar)
-> ((UTCTime, (ModuleName, SourceGrammar))
    -> (ModuleName, SourceGrammar))
-> (UTCTime, (ModuleName, SourceGrammar))
-> SourceGrammar
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UTCTime, (ModuleName, SourceGrammar))
-> (ModuleName, SourceGrammar)
forall a b. (a, b) -> b
snd) (Options -> [FilePath] -> IO (UTCTime, (ModuleName, SourceGrammar))
batchCompile Options
opts [FilePath]
files)

-- for different cf formats
importCF :: Options
-> [FilePath]
-> (Options -> FilePath -> IO [a])
-> ([a] -> [Rule (FilePath, [Param]) FilePath])
-> IO PGF
importCF Options
opts [FilePath]
files Options -> FilePath -> IO [a]
get [a] -> [Rule (FilePath, [Param]) FilePath]
convert = IO PGF
impCF
  where
    impCF :: IO PGF
impCF = do
      [Rule (FilePath, [Param]) FilePath]
rules <- ([[a]] -> [Rule (FilePath, [Param]) FilePath])
-> IO [[a]] -> IO [Rule (FilePath, [Param]) FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> [Rule (FilePath, [Param]) FilePath]
convert ([a] -> [Rule (FilePath, [Param]) FilePath])
-> ([[a]] -> [a]) -> [[a]] -> [Rule (FilePath, [Param]) FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (IO [[a]] -> IO [Rule (FilePath, [Param]) FilePath])
-> IO [[a]] -> IO [Rule (FilePath, [Param]) FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [a]) -> [FilePath] -> IO [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Options -> FilePath -> IO [a]
get Options
opts) [FilePath]
files
      (FilePath, [Param])
startCat <- case [Rule (FilePath, [Param]) FilePath]
rules of
                    (Rule (FilePath, [Param])
cat [Symbol (FilePath, [Param]) FilePath]
_ CFTerm
_ : [Rule (FilePath, [Param]) FilePath]
_) -> (FilePath, [Param]) -> IO (FilePath, [Param])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath, [Param])
cat
                    [Rule (FilePath, [Param]) FilePath]
_                  -> FilePath -> IO (FilePath, [Param])
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"empty CFG"
      let pgf :: PGF
pgf = FilePath -> ParamCFG -> PGF
cf2pgf ([FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
files) ((FilePath, [Param])
-> Set (FilePath, [Param])
-> [Rule (FilePath, [Param]) FilePath]
-> ParamCFG
forall c t.
(Ord c, Ord t) =>
c -> Set c -> [Rule c t] -> Grammar c t
mkCFG (FilePath, [Param])
startCat Set (FilePath, [Param])
forall a. Set a
Set.empty [Rule (FilePath, [Param]) FilePath]
rules)
      Probabilities
probs <- (PGF -> IO Probabilities)
-> (FilePath -> PGF -> IO Probabilities)
-> Maybe FilePath
-> PGF
-> IO Probabilities
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Probabilities -> IO Probabilities
forall (m :: * -> *) a. Monad m => a -> m a
return (Probabilities -> IO Probabilities)
-> (PGF -> Probabilities) -> PGF -> IO Probabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Probabilities
defaultProbabilities) FilePath -> PGF -> IO Probabilities
readProbabilitiesFromFile ((Flags -> Maybe FilePath) -> Options -> Maybe FilePath
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe FilePath
optProbsFile Options
opts) PGF
pgf
      PGF -> IO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return (PGF -> IO PGF) -> PGF -> IO PGF
forall a b. (a -> b) -> a -> b
$ Probabilities -> PGF -> PGF
setProbabilities Probabilities
probs 
             (PGF -> PGF) -> PGF -> PGF
forall a b. (a -> b) -> a -> b
$ if (Flags -> Bool) -> Options -> Bool
forall a. (Flags -> a) -> Options -> a
flag Flags -> Bool
optOptimizePGF Options
opts then PGF -> PGF
optimizePGF PGF
pgf else PGF
pgf