module ExampleService(cgiMain,cgiMain',newPGFCache) where
import System.Random(newStdGen)
import System.FilePath((</>),makeRelative)
import Data.Map(fromList)
import Data.Char(isDigit)
import Data.Maybe(fromJust)
import qualified Codec.Binary.UTF8.String as UTF8 (decodeString)
import PGF
import GF.Compile.ToAPI
import Network.CGI
import Text.JSON
import CGIUtils
import Cache
import qualified ExampleDemo as E

newPGFCache :: IO (Cache PGF)
newPGFCache = (FilePath -> IO PGF) -> IO (Cache PGF)
forall a. (FilePath -> IO a) -> IO (Cache a)
newCache FilePath -> IO PGF
readPGF


cgiMain :: Cache PGF -> CGI CGIResult
cgiMain :: Cache PGF -> CGI CGIResult
cgiMain = CGI CGIResult -> CGI CGIResult
forall (m :: * -> *).
(MonadCGI m, MonadCatch m, MonadIO m) =>
m CGIResult -> m CGIResult
handleErrors (CGI CGIResult -> CGI CGIResult)
-> (Cache PGF -> CGI CGIResult) -> Cache PGF -> CGI CGIResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGI CGIResult -> CGI CGIResult
handleCGIErrors (CGI CGIResult -> CGI CGIResult)
-> (Cache PGF -> CGI CGIResult) -> Cache PGF -> CGI CGIResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Cache PGF -> CGI CGIResult
cgiMain' FilePath
"." FilePath
"."

cgiMain' :: FilePath -> FilePath -> Cache PGF -> CGI CGIResult
cgiMain' FilePath
root FilePath
cwd Cache PGF
cache =
  do FilePath
command <- FilePath -> CGIT IO FilePath
getInp FilePath
"command"
     Environ
environ <- FilePath -> CGIT IO Environ
forall (m :: * -> *). MonadIO m => FilePath -> m Environ
parseEnviron (FilePath -> CGIT IO Environ)
-> CGIT IO FilePath -> CGIT IO Environ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> CGIT IO FilePath
getInp FilePath
"state"
     case FilePath
command of
       FilePath
"possibilities"    -> Environ -> CGI CGIResult
doPossibilities Environ
environ
       FilePath
"provide_example"  -> FilePath -> FilePath -> Cache PGF -> Environ -> CGI CGIResult
doProvideExample FilePath
root FilePath
cwd Cache PGF
cache Environ
environ
       FilePath
"abstract_example" -> FilePath -> Cache PGF -> Environ -> CGI CGIResult
doAbstractExample FilePath
cwd Cache PGF
cache Environ
environ
       FilePath
"test_function"    -> FilePath -> Cache PGF -> Environ -> CGI CGIResult
doTestFunction FilePath
cwd Cache PGF
cache Environ
environ
       FilePath
_ -> Int -> FilePath -> [FilePath] -> CGI CGIResult
forall a. Int -> FilePath -> [FilePath] -> CGI a
throwCGIError Int
400 (FilePath
"Unknown command: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
command) []

doPossibilities :: Environ -> CGI CGIResult
doPossibilities Environ
environ =
  do Environ
example_environ <- FilePath -> CGIT IO Environ
forall (m :: * -> *). MonadIO m => FilePath -> m Environ
parseEnviron (FilePath -> CGIT IO Environ)
-> CGIT IO FilePath -> CGIT IO Environ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> CGIT IO FilePath
getInp FilePath
"example_state"
     ([MyFunc], [MyFunc]) -> CGI CGIResult
forall a. JSON a => a -> CGI CGIResult
outputJSONP (Environ -> Environ -> ([MyFunc], [MyFunc])
E.getNext Environ
environ Environ
example_environ)

doProvideExample :: FilePath -> FilePath -> Cache PGF -> Environ -> CGI CGIResult
doProvideExample FilePath
root FilePath
cwd Cache PGF
cache Environ
environ =
  do Just MyFunc
lang <- FilePath -> CGIT IO (Maybe MyFunc)
forall a (m :: * -> *).
(Read a, MonadCGI m) =>
FilePath -> m (Maybe a)
readInput FilePath
"lang"
     MyFunc
fun <- FilePath -> CGI MyFunc
getCId FilePath
"fun"
     PGF
parsePGF <- FilePath -> Cache PGF -> CGIT IO PGF
forall b. FilePath -> Cache b -> CGIT IO b
readParsePGF FilePath
cwd Cache PGF
cache
     let adjpath :: FilePath -> FilePath
adjpath FilePath
path = FilePath
rootFilePath -> FilePath -> FilePath
</>FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" (FilePath -> FilePath -> FilePath
makeRelative FilePath
root FilePath
cwdFilePath -> FilePath -> FilePath
</>FilePath
path)
     PGF
pgf <- IO PGF -> CGIT IO PGF
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PGF -> CGIT IO PGF)
-> (FilePath -> IO PGF) -> FilePath -> CGIT IO PGF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache PGF -> FilePath -> IO PGF
forall a. Cache a -> FilePath -> IO a
readCache Cache PGF
cache (FilePath -> IO PGF)
-> (FilePath -> FilePath) -> FilePath -> IO PGF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
adjpath (FilePath -> CGIT IO PGF) -> CGIT IO FilePath -> CGIT IO PGF
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> CGIT IO FilePath
getInp FilePath
"grammar"
     StdGen
gen <- IO StdGen -> CGIT IO StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
     let Just (Expr
e,FilePath
s) = StdGen
-> Environ
-> MyFunc
-> PGF
-> PGF
-> MyFunc
-> Maybe (Expr, FilePath)
forall gen.
RandomGen gen =>
gen
-> Environ
-> MyFunc
-> PGF
-> PGF
-> MyFunc
-> Maybe (Expr, FilePath)
E.provideExample StdGen
gen Environ
environ MyFunc
fun PGF
parsePGF PGF
pgf MyFunc
lang
         res :: (FilePath, FilePath)
res = ([MyFunc] -> Expr -> FilePath
showExpr [] Expr
e,FilePath
s)
     IO () -> CGIT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CGIT IO ()) -> IO () -> CGIT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
logError (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"proveExample ... = "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++(FilePath, FilePath) -> FilePath
forall a. Show a => a -> FilePath
show (FilePath, FilePath)
res
     (FilePath, FilePath) -> CGI CGIResult
forall a. JSON a => a -> CGI CGIResult
outputJSONP (FilePath, FilePath)
res

doAbstractExample :: FilePath -> Cache PGF -> Environ -> CGI CGIResult
doAbstractExample FilePath
cwd Cache PGF
cache Environ
environ =
  do FilePath
example <- FilePath -> CGIT IO FilePath
getInp FilePath
"input"
     Just [MyFunc]
params <- FilePath -> CGIT IO (Maybe [MyFunc])
forall a (m :: * -> *).
(Read a, MonadCGI m) =>
FilePath -> m (Maybe a)
readInput FilePath
"params"
     FilePath
absstr <- FilePath -> CGIT IO FilePath
getInp FilePath
"abstract"
     Just Expr
abs <- Maybe Expr -> CGIT IO (Maybe Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Expr -> CGIT IO (Maybe Expr))
-> Maybe Expr -> CGIT IO (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Expr
readExpr FilePath
absstr
     IO () -> CGIT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CGIT IO ()) -> IO () -> CGIT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
logError (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"abstract = "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++[MyFunc] -> Expr -> FilePath
showExpr [] Expr
abs
     Just MyFunc
cat <- FilePath -> CGIT IO (Maybe MyFunc)
forall a (m :: * -> *).
(Read a, MonadCGI m) =>
FilePath -> m (Maybe a)
readInput FilePath
"cat"
     let t :: Type
t = [Hypo] -> MyFunc -> [Expr] -> Type
mkType [] MyFunc
cat []
     PGF
parsePGF <- FilePath -> Cache PGF -> CGIT IO PGF
forall b. FilePath -> Cache b -> CGIT IO b
readParsePGF FilePath
cwd Cache PGF
cache
     let MyFunc
lang:[MyFunc]
_ = PGF -> [MyFunc]
languages PGF
parsePGF
     Maybe (Expr, Expr)
ae <- IO (Maybe (Expr, Expr)) -> CGIT IO (Maybe (Expr, Expr))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Expr, Expr)) -> CGIT IO (Maybe (Expr, Expr)))
-> IO (Maybe (Expr, Expr)) -> CGIT IO (Maybe (Expr, Expr))
forall a b. (a -> b) -> a -> b
$ PGF
-> Environ
-> MyFunc
-> Type
-> Expr
-> FilePath
-> IO (Maybe (Expr, Expr))
abstractExample PGF
parsePGF Environ
environ MyFunc
lang Type
t Expr
abs FilePath
example
     Maybe (FilePath, Expr) -> CGI CGIResult
forall a. JSON a => a -> CGI CGIResult
outputJSONP (((Expr, Expr) -> (FilePath, Expr))
-> Maybe (Expr, Expr) -> Maybe (FilePath, Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Expr
e,Expr
_)->(Expr -> FilePath
exprToAPI ([MyFunc] -> Expr -> Expr
instExpMeta [MyFunc]
params Expr
e),Expr
e)) Maybe (Expr, Expr)
ae)

abstractExample :: PGF
-> Environ
-> MyFunc
-> Type
-> Expr
-> FilePath
-> IO (Maybe (Expr, Expr))
abstractExample PGF
parsePGF Environ
env MyFunc
lang Type
cat Expr
abs FilePath
example =
    Environ -> Expr -> [Expr] -> IO (Maybe (Expr, Expr))
E.searchGoodTree Environ
env Expr
abs (PGF -> MyFunc -> Type -> FilePath -> [Expr]
parse PGF
parsePGF MyFunc
lang Type
cat FilePath
example)

doTestFunction :: FilePath -> Cache PGF -> Environ -> CGI CGIResult
doTestFunction FilePath
cwd Cache PGF
cache Environ
environ =
  do MyFunc
fun <- FilePath -> CGI MyFunc
getCId FilePath
"fun"
     PGF
parsePGF <- FilePath -> Cache PGF -> CGIT IO PGF
forall b. FilePath -> Cache b -> CGIT IO b
readParsePGF FilePath
cwd Cache PGF
cache
     let MyFunc
lang:[MyFunc]
_ = PGF -> [MyFunc]
languages PGF
parsePGF
     Just FilePath
txt <- Maybe FilePath -> CGIT IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Environ -> MyFunc -> PGF -> MyFunc -> Maybe FilePath
E.testThis Environ
environ MyFunc
fun PGF
parsePGF MyFunc
lang)
     FilePath -> CGI CGIResult
forall a. JSON a => a -> CGI CGIResult
outputJSONP FilePath
txt

getCId :: String -> CGI CId
getCId :: FilePath -> CGI MyFunc
getCId FilePath
name = CGI MyFunc -> (MyFunc -> CGI MyFunc) -> Maybe MyFunc -> CGI MyFunc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CGI MyFunc
forall a. CGI a
err MyFunc -> CGI MyFunc
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MyFunc -> CGI MyFunc)
-> CGIT IO (Maybe MyFunc) -> CGI MyFunc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (FilePath -> Maybe MyFunc)
-> CGIT IO FilePath -> CGIT IO (Maybe MyFunc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe MyFunc
readCId (FilePath -> CGIT IO FilePath
getInp FilePath
name)
  where err :: CGI a
err = Int -> FilePath -> [FilePath] -> CGI a
forall a. Int -> FilePath -> [FilePath] -> CGI a
throwCGIError Int
400 (FilePath
"Bad "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
name) []
{-
getLimit :: CGI Int
getLimit = maybe err return =<< readInput "limit"
  where err = throwCGIError 400 "Missing/bad limit" []
-}

readParsePGF :: FilePath -> Cache b -> CGIT IO b
readParsePGF FilePath
cwd Cache b
cache =
    do FilePath
parsepgf <- FilePath -> CGIT IO FilePath
getInp FilePath
"parser"
       IO b -> CGIT IO b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> CGIT IO b) -> IO b -> CGIT IO b
forall a b. (a -> b) -> a -> b
$ Cache b -> FilePath -> IO b
forall a. Cache a -> FilePath -> IO a
readCache Cache b
cache (FilePath
cwdFilePath -> FilePath -> FilePath
</>FilePath
parsepgf)

parseEnviron :: FilePath -> m Environ
parseEnviron FilePath
s = do ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
 [((MyFunc, MyFunc), [MyFunc])])
state <- IO
  ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
   [((MyFunc, MyFunc), [MyFunc])])
-> m ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
      [((MyFunc, MyFunc), [MyFunc])])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
    [((MyFunc, MyFunc), [MyFunc])])
 -> m ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
       [((MyFunc, MyFunc), [MyFunc])]))
-> IO
     ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
      [((MyFunc, MyFunc), [MyFunc])])
-> m ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
      [((MyFunc, MyFunc), [MyFunc])])
forall a b. (a -> b) -> a -> b
$ FilePath
-> IO
     ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
      [((MyFunc, MyFunc), [MyFunc])])
forall a. Read a => FilePath -> IO a
readIO FilePath
s
                    Environ -> m Environ
forall (m :: * -> *) a. Monad m => a -> m a
return (Environ -> m Environ) -> Environ -> m Environ
forall a b. (a -> b) -> a -> b
$ ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
 [((MyFunc, MyFunc), [MyFunc])])
-> Environ
environ ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
 [((MyFunc, MyFunc), [MyFunc])])
state

getInp :: FilePath -> CGIT IO FilePath
getInp FilePath
name = CGIT IO FilePath
-> (FilePath -> CGIT IO FilePath)
-> Maybe FilePath
-> CGIT IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CGIT IO FilePath
forall a. CGI a
err (FilePath -> CGIT IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> CGIT IO FilePath)
-> (FilePath -> FilePath) -> FilePath -> CGIT IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
UTF8.decodeString) (Maybe FilePath -> CGIT IO FilePath)
-> CGIT IO (Maybe FilePath) -> CGIT IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> CGIT IO (Maybe FilePath)
forall (m :: * -> *). MonadCGI m => FilePath -> m (Maybe FilePath)
getInput FilePath
name
  where err :: CGI a
err = Int -> FilePath -> [FilePath] -> CGI a
forall a. Int -> FilePath -> [FilePath] -> CGI a
throwCGIError Int
400 (FilePath
"Missing parameter: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
name) []


instance JSON CId where
    showJSON :: MyFunc -> JSValue
showJSON = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON (FilePath -> JSValue) -> (MyFunc -> FilePath) -> MyFunc -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyFunc -> FilePath
forall a. Show a => a -> FilePath
show
    readJSON :: JSValue -> Result MyFunc
readJSON = (FilePath -> Result MyFunc
forall a. Read a => FilePath -> Result a
readResult (FilePath -> Result MyFunc) -> Result FilePath -> Result MyFunc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Result FilePath -> Result MyFunc)
-> (JSValue -> Result FilePath) -> JSValue -> Result MyFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result FilePath
forall a. JSON a => JSValue -> Result a
readJSON

instance JSON Expr where
   showJSON :: Expr -> JSValue
showJSON = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON (FilePath -> JSValue) -> (Expr -> FilePath) -> Expr -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MyFunc] -> Expr -> FilePath
showExpr []
   readJSON :: JSValue -> Result Expr
readJSON = (Maybe Expr -> Result Expr
forall a. Maybe a -> Result a
m2r (Maybe Expr -> Result Expr)
-> (FilePath -> Maybe Expr) -> FilePath -> Result Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Expr
readExpr (FilePath -> Result Expr) -> Result FilePath -> Result Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Result FilePath -> Result Expr)
-> (JSValue -> Result FilePath) -> JSValue -> Result Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result FilePath
forall a. JSON a => JSValue -> Result a
readJSON

m2r :: Maybe a -> Result a
m2r = Result a -> (a -> Result a) -> Maybe a -> Result a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Result a
forall a. FilePath -> Result a
Error FilePath
"read failed") a -> Result a
forall a. a -> Result a
Ok

readResult :: FilePath -> Result a
readResult FilePath
s = case ReadS a
forall a. Read a => ReadS a
reads FilePath
s of
                 (a
x,FilePath
r):[(a, FilePath)]
_ | ReadS FilePath
lex FilePath
r[(FilePath, FilePath)] -> [(FilePath, FilePath)] -> Bool
forall a. Eq a => a -> a -> Bool
==[(FilePath
"",FilePath
"")] -> a -> Result a
forall a. a -> Result a
Ok a
x
                 [(a, FilePath)]
_ -> FilePath -> Result a
forall a. FilePath -> Result a
Error FilePath
"read failed"

--------------------------------------------------------------------------------
--            cat  lincat  fun  lin       fun  cat    cat
environ :: ([(CId, CId)],[(CId, Expr)],[((CId, CId), [CId])]) -> E.Environ
environ :: ([(MyFunc, MyFunc)], [(MyFunc, Expr)],
 [((MyFunc, MyFunc), [MyFunc])])
-> Environ
environ ([(MyFunc, MyFunc)]
lincats,[(MyFunc, Expr)]
lins0,[((MyFunc, MyFunc), [MyFunc])]
funs) =
    TypeMap -> ConcMap -> [FuncWithArg] -> [FuncWithArg] -> Environ
E.initial ([(MyFunc, MyFunc)] -> TypeMap
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(MyFunc, MyFunc)]
lincats) ConcMap
concmap [FuncWithArg]
fs [FuncWithArg]
allfs
  where
    concmap :: ConcMap
concmap = [(MyFunc, Expr)] -> ConcMap
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(MyFunc, Expr)]
lins
    allfs :: [FuncWithArg]
allfs = (((MyFunc, MyFunc), [MyFunc]) -> FuncWithArg)
-> [((MyFunc, MyFunc), [MyFunc])] -> [FuncWithArg]
forall a b. (a -> b) -> [a] -> [b]
map ((MyFunc, MyFunc), [MyFunc]) -> FuncWithArg
E.mkFuncWithArg [((MyFunc, MyFunc), [MyFunc])]
funs
    fs :: [FuncWithArg]
fs = [((MyFunc, MyFunc), [MyFunc]) -> FuncWithArg
E.mkFuncWithArg ((MyFunc, MyFunc), [MyFunc])
f | f :: ((MyFunc, MyFunc), [MyFunc])
f@((MyFunc
fn,MyFunc
_),[MyFunc]
_)<-[((MyFunc, MyFunc), [MyFunc])]
funs, MyFunc
fn MyFunc -> [MyFunc] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MyFunc]
cns]
    cns :: [MyFunc]
cns = ((MyFunc, Expr) -> MyFunc) -> [(MyFunc, Expr)] -> [MyFunc]
forall a b. (a -> b) -> [a] -> [b]
map (MyFunc, Expr) -> MyFunc
forall a b. (a, b) -> a
fst [(MyFunc, Expr)]
lins
    lins :: [(MyFunc, Expr)]
lins = ((MyFunc, Expr) -> Bool) -> [(MyFunc, Expr)] -> [(MyFunc, Expr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((MyFunc, Expr) -> Bool) -> (MyFunc, Expr) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Bool
E.isMeta (Expr -> Bool)
-> ((MyFunc, Expr) -> Expr) -> (MyFunc, Expr) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MyFunc, Expr) -> Expr
forall a b. (a, b) -> b
snd) [(MyFunc, Expr)]
lins0


instExpMeta :: [CId] -> Expr -> Expr
instExpMeta :: [MyFunc] -> Expr -> Expr
instExpMeta [MyFunc]
ps = Maybe Expr -> Expr
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Expr -> Expr) -> (Expr -> Maybe Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Expr
readExpr (FilePath -> Maybe Expr)
-> (Expr -> FilePath) -> Expr -> Maybe Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MyFunc] -> FilePath -> FilePath
instMeta [MyFunc]
ps (FilePath -> FilePath) -> (Expr -> FilePath) -> Expr -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MyFunc] -> Expr -> FilePath
showExpr []

instMeta :: [CId] -> String -> String
instMeta :: [MyFunc] -> FilePath -> FilePath
instMeta [MyFunc]
ps FilePath
s =
  case (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 of
    (FilePath
s1,Char
'?':FilePath
s2) ->
       case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit FilePath
s2 of
         (s21 :: FilePath
s21@(Char
_:FilePath
_),FilePath
s22) -> FilePath
s1FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++MyFunc -> FilePath
forall a. Show a => a -> FilePath
show ([MyFunc]
ps[MyFunc] -> Int -> MyFunc
forall a. [a] -> Int -> a
!!(FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
s21Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++[MyFunc] -> FilePath -> FilePath
instMeta [MyFunc]
ps FilePath
s22
         (FilePath
"",FilePath
s22) -> FilePath
s1FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Char
'?'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:[MyFunc] -> FilePath -> FilePath
instMeta [MyFunc]
ps FilePath
s22
    (FilePath
_,FilePath
_) -> FilePath
s