module GF.Compile.ExampleBased (
parseExamplesInGrammar,
configureExBased
) where
import PGF
import Data.List
parseExamplesInGrammar :: ExConfiguration -> FilePath -> IO (FilePath,[String])
parseExamplesInGrammar :: ExConfiguration -> FilePath -> IO (FilePath, [FilePath])
parseExamplesInGrammar ExConfiguration
conf FilePath
file = do
FilePath
src <- FilePath -> IO FilePath
readFile FilePath
file
let file' :: FilePath
file' = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"gf"
[FilePath]
ws <- ExConfiguration -> FilePath -> FilePath -> IO [FilePath]
convertFile ExConfiguration
conf FilePath
src FilePath
file'
(FilePath, [FilePath]) -> IO (FilePath, [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file',[FilePath]
ws)
convertFile :: ExConfiguration -> String -> FilePath -> IO [String]
convertFile :: ExConfiguration -> FilePath -> FilePath -> IO [FilePath]
convertFile ExConfiguration
conf FilePath
src FilePath
file = do
FilePath -> FilePath -> IO ()
writeFile FilePath
file FilePath
""
[FilePath] -> FilePath -> IO [FilePath]
conv [] FilePath
src
where
conv :: [FilePath] -> FilePath -> IO [FilePath]
conv [FilePath]
ws FilePath
s = do
((FilePath, FilePath)
cex,FilePath
end) <- FilePath -> IO ((FilePath, FilePath), FilePath)
findExample FilePath
s
if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
end then [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
ws)) else do
[FilePath]
ws2 <- (FilePath, FilePath) -> IO [FilePath]
convEx (FilePath, FilePath)
cex
[FilePath] -> FilePath -> IO [FilePath]
conv ([FilePath]
ws2 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
ws) FilePath
end
findExample :: FilePath -> IO ((FilePath, FilePath), FilePath)
findExample FilePath
s = case FilePath
s of
Char
'%':Char
'e':Char
'x':FilePath
cs -> ((FilePath, FilePath), FilePath)
-> IO ((FilePath, FilePath), FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (((FilePath, FilePath), FilePath)
-> IO ((FilePath, FilePath), FilePath))
-> ((FilePath, FilePath), FilePath)
-> IO ((FilePath, FilePath), FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> ((FilePath, FilePath), FilePath)
getExample FilePath
cs
Char
c:FilePath
cs -> FilePath -> IO ()
appf [Char
c] IO ()
-> IO ((FilePath, FilePath), FilePath)
-> IO ((FilePath, FilePath), FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ((FilePath, FilePath), FilePath)
findExample FilePath
cs
FilePath
_ -> ((FilePath, FilePath), FilePath)
-> IO ((FilePath, FilePath), FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, FilePath)
forall a. HasCallStack => a
undefined,FilePath
s)
getExample :: FilePath -> ((FilePath, FilePath), FilePath)
getExample FilePath
s =
let
(FilePath
cat,FilePath
exend) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'"') FilePath
s
(FilePath
ex, FilePath
end) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'"') (FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
exend)
in (([FilePath] -> FilePath
unwords (FilePath -> [FilePath]
words FilePath
cat),FilePath
ex), FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
end)
pgf :: PGF
pgf = ExConfiguration -> PGF
resource_pgf ExConfiguration
conf
morpho :: Morpho
morpho = ExConfiguration -> Morpho
resource_morpho ExConfiguration
conf
lang :: Language
lang = ExConfiguration -> Language
language ExConfiguration
conf
convEx :: (FilePath, FilePath) -> IO [FilePath]
convEx (FilePath
cat,FilePath
ex) = do
FilePath -> IO ()
appn FilePath
"("
let typ :: Type
typ = Type -> (Type -> Type) -> Maybe Type -> Type
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Type
forall a. HasCallStack => FilePath -> a
error FilePath
"no valid cat") Type -> Type
forall a. a -> a
id (Maybe Type -> Type) -> Maybe Type -> Type
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Type
readType FilePath
cat
[FilePath]
ws <- case (ParseOutput, BracketedString) -> ParseOutput
forall a b. (a, b) -> a
fst (PGF
-> Language
-> Type
-> Maybe Int
-> FilePath
-> (ParseOutput, BracketedString)
parse_ PGF
pgf Language
lang Type
typ (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) FilePath
ex) of
ParseFailed Int
_ -> do
let ws :: [FilePath]
ws = Morpho -> [FilePath] -> [FilePath]
morphoMissing Morpho
morpho (FilePath -> [FilePath]
words FilePath
ex)
FilePath -> IO ()
appv (FilePath
"WARNING: cannot parse example " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ex)
case [FilePath]
ws of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[FilePath]
_ -> FilePath -> IO ()
appv (FilePath
" missing words: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
ws)
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
ws
TypeError [(Int, TcError)]
_ ->
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
ParseOutput
ParseIncomplete ->
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
ParseOk [Tree]
ts ->
case [Tree] -> [FilePath]
rank [Tree]
ts of
(FilePath
t:[FilePath]
tt) -> do
if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
tt
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else FilePath -> IO ()
appv (FilePath
"WARNING: ambiguous example " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ex)
FilePath -> IO ()
appn FilePath
t
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
appn (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
" --- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)) [FilePath]
tt
FilePath -> IO ()
appn FilePath
")"
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
ws
rank :: [Tree] -> [FilePath]
rank [Tree]
ts = [ExConfiguration -> Tree -> FilePath
printExp ExConfiguration
conf Tree
t FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" -- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Double -> FilePath
forall a. Show a => a -> FilePath
show Double
p | (Tree
t,Double
p) <- PGF -> [Tree] -> [(Tree, Double)]
rankTreesByProbs PGF
pgf [Tree]
ts]
appf :: FilePath -> IO ()
appf = FilePath -> FilePath -> IO ()
appendFile FilePath
file
appn :: FilePath -> IO ()
appn FilePath
s = FilePath -> IO ()
appf FilePath
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
appf FilePath
"\n"
appv :: FilePath -> IO ()
appv FilePath
s = FilePath -> IO ()
appn (FilePath
"--- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
putStrLn FilePath
s
data ExConfiguration = ExConf {
ExConfiguration -> PGF
resource_pgf :: PGF,
ExConfiguration -> Morpho
resource_morpho :: Morpho,
ExConfiguration -> Bool
verbose :: Bool,
ExConfiguration -> Language
language :: Language,
ExConfiguration -> Tree -> FilePath
printExp :: Tree -> String
}
configureExBased :: PGF -> Morpho -> Language -> (Tree -> String) -> ExConfiguration
configureExBased :: PGF -> Morpho -> Language -> (Tree -> FilePath) -> ExConfiguration
configureExBased PGF
pgf Morpho
morpho Language
lang Tree -> FilePath
pr = PGF
-> Morpho
-> Bool
-> Language
-> (Tree -> FilePath)
-> ExConfiguration
ExConf PGF
pgf Morpho
morpho Bool
False Language
lang Tree -> FilePath
pr