diff --git a/.gitignore b/.gitignore index aedc1fd42..678397df2 100644 --- a/.gitignore +++ b/.gitignore @@ -56,6 +56,12 @@ DATA_DIR stack*.yaml.lock +# Generated source files +src/compiler/api/GF/Grammar/Lexer.hs +src/compiler/api/GF/Grammar/Parser.hs +src/compiler/api/PackageInfo_gf.hs +src/compiler/api/Paths_gf.hs + # Output files for test suite *.out gf-tests.html diff --git a/src/compiler/api/GF/Compile/Compute/Concrete.hs b/src/compiler/api/GF/Compile/Compute/Concrete.hs index 7d7d65c7a..0732da17e 100644 --- a/src/compiler/api/GF/Compile/Compute/Concrete.hs +++ b/src/compiler/api/GF/Compile/Compute/Concrete.hs @@ -26,6 +26,7 @@ import GF.Grammar.Predef import GF.Grammar.Lockfield(lockLabel) import GF.Grammar.Printer import GF.Data.Operations(Err(..)) +import GF.Data.Utilities((<||>),anyM) import GF.Infra.CheckM import GF.Infra.Option import Data.STRef @@ -142,6 +143,37 @@ showValue (VAlts _ _) = "VAlts" showValue (VStrs _) = "VStrs" showValue (VSymCat _ _ _) = "VSymCat" +isOpen :: [Ident] -> Term -> EvalM s Bool +isOpen bound (Vr x) = return $ x `notElem` bound +isOpen bound (App f x) = isOpen bound f <||> isOpen bound x +isOpen bound (Abs b x t) = isOpen (x:bound) t +isOpen bound (ImplArg t) = isOpen bound t +isOpen bound (Prod b x d cod) = isOpen bound d <||> isOpen (x:bound) cod +isOpen bound (Typed t ty) = isOpen bound t +isOpen bound (Example t s) = isOpen bound t +isOpen bound (RecType fs) = anyM (isOpen bound . snd) fs +isOpen bound (R fs) = anyM (isOpen bound . snd . snd) fs +isOpen bound (P t f) = isOpen bound t +isOpen bound (ExtR t t') = isOpen bound t <||> isOpen bound t' +isOpen bound (Table d cod) = isOpen bound d <||> isOpen bound cod +isOpen bound (T (TTyped ty) cs) = isOpen bound ty <||> anyM (isOpen bound . snd) cs +isOpen bound (T (TWild ty) cs) = isOpen bound ty <||> anyM (isOpen bound . snd) cs +isOpen bound (T _ cs) = anyM (isOpen bound . snd) cs +isOpen bound (V ty cs) = isOpen bound ty <||> anyM (isOpen bound) cs +isOpen bound (S t x) = isOpen bound t <||> isOpen bound x +isOpen bound (Let (x,(ty,d)) t) = isOpen bound d <||> isOpen (x:bound) t +isOpen bound (C t t') = isOpen bound t <||> isOpen bound t' +isOpen bound (Glue t t') = isOpen bound t <||> isOpen bound t' +isOpen bound (EPattType ty) = isOpen bound ty +isOpen bound (ELincat c ty) = isOpen bound ty +isOpen bound (ELin c t) = isOpen bound t +isOpen bound (FV ts) = anyM (isOpen bound) ts +isOpen bound (Markup tag as ts) = anyM (isOpen bound) ts <||> anyM (isOpen bound . snd) as +isOpen bound (Reset c t) = isOpen bound t +isOpen bound (Alts d as) = isOpen bound d <||> anyM (\(x,y) -> isOpen bound x <||> isOpen bound y) as +isOpen bound (Strs ts) = anyM (isOpen bound) ts +isOpen _ _ = return False + eval env (Vr x) vs = do (tnk,depth) <- lookup x env withVar depth $ do v <- force tnk @@ -207,12 +239,14 @@ eval env (S t1 t2) vs = do v1 <- eval env t1 [] eval env (Let (x,(_,t1)) t2) vs = do tnk <- newThunk env t1 eval ((x,tnk):env) t2 vs eval env (Q q@(m,id)) vs - | m == cPredef = do vs' <- mapM force vs - res <- evalPredef id vs' - case res of - Const res -> return res - RunTime -> return (VApp q vs) - NonExist -> return (VApp (cPredef,cNonExist) []) + | m == cPredef = do vs' <- mapM force vs -- FIXME this does not allow for partial application! + open <- anyM (value2term True [] >=> isOpen []) vs' + if open then return (VApp q vs) else do + res <- evalPredef id vs' + case res of + Const res -> return res + RunTime -> return (VApp q vs) + NonExist -> return (VApp (cPredef,cNonExist) []) | otherwise = do t <- getResDef q eval env t vs eval env (QC q) vs = return (VApp q vs) diff --git a/src/compiler/api/GF/Compile/Repl.hs b/src/compiler/api/GF/Compile/Repl.hs new file mode 100644 index 000000000..f3b748361 --- /dev/null +++ b/src/compiler/api/GF/Compile/Repl.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE LambdaCase #-} + +module GF.Compile.Repl (ReplOpts(..), defaultReplOpts, replOptDescrs, getReplOpts, runRepl, runRepl') where + +import Control.Monad (unless, forM_, foldM) +import Control.Monad.IO.Class (MonadIO) +import qualified Data.ByteString.Char8 as BS +import Data.Char (isSpace) +import Data.Function ((&)) +import Data.Functor ((<&>)) +import qualified Data.Map as Map + +import System.Console.GetOpt (ArgOrder(RequireOrder), OptDescr(..), ArgDescr(..), getOpt, usageInfo) +import System.Console.Haskeline (InputT, Settings(..), noCompletion, runInputT, getInputLine, outputStrLn) +import System.Directory (getAppUserDataDirectory) + +import GF.Compile (batchCompile) +import GF.Compile.Compute.Concrete (Globals(Gl), stdPredef, normalFlatForm) +import GF.Compile.Rename (renameSourceTerm) +import GF.Compile.TypeCheck.ConcreteNew (inferLType) +import GF.Data.ErrM (Err(..)) +import GF.Grammar.Grammar + ( Grammar + , mGrammar + , Info + , Module + , ModuleName + , ModuleInfo(..) + , ModuleType(MTResource) + , ModuleStatus(MSComplete) + , OpenSpec(OSimple) + , Location (NoLoc) + , Term + , prependModule + ) +import GF.Grammar.Lexer (Posn(..), Lang(GF), runLangP) +import GF.Grammar.Parser (pTerm) +import GF.Grammar.Printer (TermPrintQual(Unqualified), ppTerm) +import GF.Infra.CheckM (Check, runCheck) +import GF.Infra.Ident (moduleNameS) +import GF.Infra.Option (noOptions) +import GF.Infra.UseIO (justModuleName) +import GF.Text.Pretty (render) + +data ReplOpts = ReplOpts + { noPrelude :: Bool + , inputFiles :: [String] + } + +defaultReplOpts :: ReplOpts +defaultReplOpts = ReplOpts False [] + +type Errs a = Either [String] a +type ReplOptsOp = ReplOpts -> Errs ReplOpts + +replOptDescrs :: [OptDescr ReplOptsOp] +replOptDescrs = + [ Option ['h'] ["help"] (NoArg $ \o -> Left [usageInfo "gfci" replOptDescrs]) "Display help." + , Option [] ["no-prelude"] (flag $ \o -> o { noPrelude = True }) "Don't load the prelude." + ] + where + flag f = NoArg $ \o -> pure (f o) + +getReplOpts :: [String] -> Errs ReplOpts +getReplOpts args = case errs of + [] -> foldM (&) defaultReplOpts flags <&> \o -> o { inputFiles = inputFiles } + _ -> Left errs + where + (flags, inputFiles, errs) = getOpt RequireOrder replOptDescrs args + +execCheck :: MonadIO m => Check a -> (a -> InputT m ()) -> InputT m () +execCheck c k = case runCheck c of + Ok (a, warn) -> do + unless (null warn) $ outputStrLn warn + k a + Bad err -> outputStrLn err + +replModNameStr :: String +replModNameStr = "" + +replModName :: ModuleName +replModName = moduleNameS replModNameStr + +parseThen :: MonadIO m => Grammar -> String -> (Term -> InputT m ()) -> InputT m () +parseThen g s k = case runLangP GF pTerm (BS.pack s) of + Left (Pn l c, err) -> outputStrLn $ err ++ " (" ++ show l ++ ":" ++ show c ++ ")" + Right t -> execCheck (renameSourceTerm g replModName t) $ \t -> k t + +runRepl' :: Globals -> IO () +runRepl' gl@(Gl g _) = do + historyFile <- getAppUserDataDirectory "gfci_history" + runInputT (Settings noCompletion (Just historyFile) True) repl -- TODO tab completion + where + repl = do + getInputLine "gfci> " >>= \case + Nothing -> repl + Just (':' : l) -> let (cmd, arg) = break isSpace l in command cmd (dropWhile isSpace arg) + Just code -> evalPrintLoop code + + command "t" arg = do + parseThen g arg $ \main -> + execCheck (inferLType gl main) $ \(_, ty) -> + outputStrLn $ render (ppTerm Unqualified 0 ty) + outputStrLn "" >> repl + + command "q" _ = outputStrLn "Bye!" + + command cmd _ = do + outputStrLn $ "Unknown REPL command: " ++ cmd + outputStrLn "" >> repl + + evalPrintLoop code = do -- TODO bindings + parseThen g code $ \main -> + execCheck (inferLType gl main >>= \(t, _) -> normalFlatForm gl t) $ \nfs -> + forM_ (zip [1..] nfs) $ \(i, nf) -> + outputStrLn $ show i ++ ". " ++ render (ppTerm Unqualified 0 nf) + outputStrLn "" >> repl + +runRepl :: ReplOpts -> IO () +runRepl (ReplOpts noPrelude inputFiles) = do + -- TODO accept an ngf grammar + let toLoad = if noPrelude then inputFiles else "prelude/Predef.gfo" : inputFiles + (g0, opens) <- case toLoad of + [] -> pure (mGrammar [], []) + _ -> do + (_, (_, g0)) <- batchCompile noOptions Nothing toLoad + pure (g0, OSimple . moduleNameS . justModuleName <$> toLoad) + let + modInfo = ModInfo + { mtype = MTResource + , mstatus = MSComplete + , mflags = noOptions + , mextend = [] + , mwith = Nothing + , mopens = opens + , mexdeps = [] + , msrc = replModNameStr + , mseqs = Nothing + , jments = Map.empty + } + runRepl' (Gl (prependModule g0 (replModName, modInfo)) (if noPrelude then Map.empty else stdPredef)) diff --git a/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs index a314aed49..8da8d5de7 100644 --- a/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs +++ b/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE RankNTypes, CPP #-} -module GF.Compile.TypeCheck.ConcreteNew( checkLType, inferLType ) where +{-# LANGUAGE RankNTypes, CPP, TupleSections #-} +module GF.Compile.TypeCheck.ConcreteNew( checkLType, checkLType', inferLType, inferLType' ) where -- The code here is based on the paper: -- Simon Peyton Jones, Dimitrios Vytiniotis, Stephanie Weirich. @@ -12,26 +12,33 @@ import GF.Grammar.Predef import GF.Grammar.Lockfield import GF.Compile.Compute.Concrete import GF.Infra.CheckM -import GF.Data.Operations +import GF.Data.ErrM ( Err(Ok, Bad) ) import Control.Applicative(Applicative(..)) -import Control.Monad(ap,liftM,mplus,foldM,zipWithM,forM) +import Control.Monad(ap,liftM,mplus,foldM,zipWithM,forM,filterM,unless) import Control.Monad.ST import GF.Text.Pretty import Data.STRef import Data.List (nub, (\\), tails) import qualified Data.Map as Map -import Data.Maybe(fromMaybe,isNothing) +import Data.Maybe(fromMaybe,isNothing,mapMaybe) +import Data.Functor((<&>)) import qualified Control.Monad.Fail as Fail checkLType :: Globals -> Term -> Type -> Check (Term, Type) -checkLType globals t ty = runEvalOneM globals $ do +checkLType globals t ty = runEvalOneM globals (checkLType' t ty) + +checkLType' :: Term -> Type -> EvalM s (Term, Type) +checkLType' t ty = do vty <- eval [] ty [] (t,_) <- tcRho [] t (Just vty) t <- zonkTerm [] t return (t,ty) inferLType :: Globals -> Term -> Check (Term, Type) -inferLType globals t = runEvalOneM globals $ do +inferLType globals t = runEvalOneM globals (inferLType' t) + +inferLType' :: Term -> EvalM s (Term, Type) +inferLType' t = do (t,ty) <- inferSigma [] t t <- zonkTerm [] t ty <- value2term False [] ty @@ -64,13 +71,13 @@ tcRho scope t@(Vr v) mb_ty = do -- VAR Just v_sigma -> instSigma scope t v_sigma mb_ty Nothing -> evalError ("Unknown variable" <+> v) tcRho scope t@(Q id) mb_ty = do - (t,ty) <- tcApp scope t t + (t,ty) <- tcApp scope t t [] instSigma scope t ty mb_ty tcRho scope t@(QC id) mb_ty = do - (t,ty) <- tcApp scope t t + (t,ty) <- tcApp scope t t [] instSigma scope t ty mb_ty tcRho scope t@(App fun arg) mb_ty = do - (t,ty) <- tcApp scope t t + (t,ty) <- tcApp scope t t [] instSigma scope t ty mb_ty tcRho scope (Abs bt var body) Nothing = do -- ABS1 (i,tnk) <- newResiduation scope @@ -105,7 +112,6 @@ tcRho scope (Abs bt var body) Nothing = do -- ABS1 v2 <- eval ((x,tnk):env) t [] check m (n+1) (b,x:xs) v2 v2 -> check m n st v2 - check m (n+1) (b,x:xs) v2 check m n st (VRecType as) = foldM (\st (l,v) -> check m n st v) st as check m n st (VR as) = foldM (\st (lbl,tnk) -> follow m n st tnk) st as @@ -376,21 +382,27 @@ tcCases scope ((p,t):cs) p_ty res_ty = do cs <- tcCases scope cs p_ty res_ty return ((p,t):cs) -tcApp scope t0 t@(App fun (ImplArg arg)) = do -- APP1 - (fun,fun_ty) <- tcApp scope t0 fun +tcApp scope t0 (App fun arg) args = tcApp scope t0 fun (arg:args) -- APP +tcApp scope t0 (Q id) args = resolveOverloads scope t0 id args -- VAR (global) +tcApp scope t0 (QC id) args = resolveOverloads scope t0 id args -- VAR (global) +tcApp scope t0 t args = do + (t,ty) <- tcRho scope t Nothing + reapply scope t ty args + +reapply :: Scope s -> Term -> Constraint s -> [Term] -> EvalM s (Term,Rho s) +reapply scope fun fun_ty [] = return (fun,fun_ty) +reapply scope fun fun_ty ((ImplArg arg):args) = do -- Implicit arg case (bt, x, arg_ty, res_ty) <- unifyFun scope fun_ty - if (bt == Implicit) - then return () - else evalError (ppTerm Unqualified 0 t <+> "is an implicit argument application, but no implicit argument is expected") + unless (bt == Implicit) $ evalError (ppTerm Unqualified 0 (App fun (ImplArg arg)) <+> + "is an implicit argument application, but no implicit argument is expected") (arg,_) <- tcRho scope arg (Just arg_ty) res_ty <- case res_ty of VClosure res_env res_ty -> do env <- scopeEnv scope tnk <- newThunk env arg eval ((x,tnk):res_env) res_ty [] - res_ty -> return res_ty - return (App fun (ImplArg arg), res_ty) -tcApp scope t0 (App fun arg) = do -- APP2 - (fun,fun_ty) <- tcApp scope t0 fun + res_ty -> return res_ty + reapply scope (App fun (ImplArg arg)) res_ty args +reapply scope fun fun_ty (arg:args) = do -- Explicit arg (fallthrough) case (fun,fun_ty) <- instantiate scope fun fun_ty (_, x, arg_ty, res_ty) <- unifyFun scope fun_ty (arg,_) <- tcRho scope arg (Just arg_ty) @@ -399,22 +411,61 @@ tcApp scope t0 (App fun arg) = do -- APP2 tnk <- newThunk env arg eval ((x,tnk):res_env) res_ty [] res_ty -> return res_ty - return (App fun arg, res_ty) -tcApp scope t0 (Q id) = do -- VAR (global) - (t,ty) <- getOverload t0 id - vty <- eval [] ty [] - return (t,vty) -tcApp scope t0 (QC id) = do -- VAR (global) - (t,ty) <- getOverload t0 id - vty <- eval [] ty [] - return (t,vty) -tcApp scope t0 t = tcRho scope t Nothing + reapply scope (App fun arg) res_ty args + +resolveOverloads :: Scope s -> Term -> QIdent -> [Term] -> EvalM s (Term,Rho s) +resolveOverloads scope t q args = EvalM $ \gl@(Gl gr _) k mt d r msgs -> + case lookupOverloadTypes gr q of + Bad msg -> return $ Fail (pp msg) msgs + Ok [tty] -> try tty gl k mt d r msgs -- skip overload resolution if there's only one overload + Ok ttys -> do rs <- mapM (\tty -> (tty,) <$> try tty gl k mt d r msgs) ttys + let successes = mapMaybe isSuccess rs + r <- case successes of + [] -> return $ Fail mempty msgs + [(_,r,msgs)] -> return $ Success r msgs + _ -> case unifyOverloads (successes <&> \(tty,_,_) -> tty) of + EvalM f -> f gl k mt d r msgs + return $ case r of + s@(Success _ _) -> s + Fail err msgs -> let h = "Overload resolution failed" $$ + "of term " <+> pp t $$ + "with types" <+> vcat [ppTerm Terse 0 ty | (_,ty) <- ttys] + in Fail (h $+$ err) msgs + where + try (t,ty) = case eval [] ty [] >>= \vty -> reapply scope t vty args of EvalM f -> f + + isSuccess (tty, Success r msg) = Just (tty,r,msg) + isSuccess (_, Fail _ _) = Nothing -tcOverloadFailed t ttys = - evalError ("Overload resolution failed" $$ - "of term " <+> pp t $$ - "with types" <+> vcat [ppTerm Terse 0 ty | (_,ty) <- ttys]) + unifyOverloads ttys = do + ttys <- forM ttys $ \(t,ty) -> do + vty <- eval [] ty [] + (t,vty) <- papply scope t vty args + return (t,vty) + (_,tnk) <- newResiduation scope + let mv = VMeta tnk [] + mapM_ (\(_,vty) -> unify scope vty mv) ttys + fvty <- force tnk + return (FV (fst <$> ttys), fvty) + papply scope fun fun_ty [] = return (fun,fun_ty) + papply scope fun (VProd Implicit x arg_ty res_ty) ((ImplArg arg):args) = do -- Implicit arg case + (arg,_) <- tcRho scope arg (Just arg_ty) + res_ty <- case res_ty of + VClosure res_env res_ty -> do env <- scopeEnv scope + tnk <- newThunk env arg + eval ((x,tnk):res_env) res_ty [] + res_ty -> return res_ty + papply scope (App fun (ImplArg arg)) res_ty args + papply scope fun fun_ty (arg:args) = do -- Explicit arg (fallthrough) case + (fun,VProd Explicit x arg_ty res_ty) <- instantiate scope fun fun_ty + (arg,_) <- tcRho scope arg (Just arg_ty) + res_ty <- case res_ty of + VClosure res_env res_ty -> do env <- scopeEnv scope + tnk <- newThunk env arg + eval ((x,tnk):res_env) res_ty [] + res_ty -> return res_ty + papply scope (App fun arg) res_ty args tcPatt scope PW ty0 = return scope diff --git a/src/compiler/api/GF/Data/Utilities.hs b/src/compiler/api/GF/Data/Utilities.hs index 913953b6e..1faa0b4ac 100644 --- a/src/compiler/api/GF/Data/Utilities.hs +++ b/src/compiler/api/GF/Data/Utilities.hs @@ -16,7 +16,7 @@ module GF.Data.Utilities(module GF.Data.Utilities) where import Data.Maybe import Data.List -import Control.Monad (MonadPlus(..),liftM,when) +import Control.Monad (MonadPlus(..),foldM,liftM,when) import qualified Data.Set as Set -- * functions on lists @@ -140,6 +140,25 @@ whenM bm m = flip when m =<< bm repeatM m = whenM m (repeatM m) +infixr 3 <&&> +infixr 2 <||> + +-- | Boolean conjunction lifted to applicative functors. +(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool +(<&&>) = liftA2 (&&) + +-- | Boolean disjunction lifted to applicative functors. +(<||>) :: Applicative f => f Bool -> f Bool -> f Bool +(<||>) = liftA2 (||) + +-- | Check whether a monadic predicate holds for every element of a collection. +allM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool +allM p = foldM (\b x -> if b then p x else return False) True + +-- | Check whether a monadic predicate holds for any element of a collection. +anyM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool +anyM p = foldM (\b x -> if b then return True else p x) False + -- * functions on Maybes -- | Returns true if the argument is Nothing or Just [] diff --git a/src/compiler/api/GF/Interactive.hs b/src/compiler/api/GF/Interactive.hs index 59d5df5b1..80e60ef8e 100644 --- a/src/compiler/api/GF/Interactive.hs +++ b/src/compiler/api/GF/Interactive.hs @@ -39,6 +39,7 @@ import qualified Data.Sequence as Seq import qualified Text.ParserCombinators.ReadP as RP import System.Directory(getAppUserDataDirectory) import Control.Exception(SomeException,fromException,evaluate,try) +import Control.Monad ((<=<),when,mplus,join) import Control.Monad.State hiding (void) import qualified GF.System.Signal as IO(runInterruptibly) import GF.Command.Messages(welcome) diff --git a/src/compiler/api/GF/Term.hs b/src/compiler/api/GF/Term.hs index d9ffc9538..410360ea8 100644 --- a/src/compiler/api/GF/Term.hs +++ b/src/compiler/api/GF/Term.hs @@ -2,7 +2,7 @@ module GF.Term (renameSourceTerm, Globals(..), ConstValue(..), EvalM, stdPredef, Value(..), showValue, Thunk, newThunk, newEvaluatedThunk, evalError, evalWarn, - inferLType, checkLType, + inferLType, inferLType', checkLType, checkLType', normalForm, normalFlatForm, normalStringForm, unsafeIOToEvalM, force ) where diff --git a/src/compiler/gf-repl.hs b/src/compiler/gf-repl.hs new file mode 100644 index 000000000..5b890fa9e --- /dev/null +++ b/src/compiler/gf-repl.hs @@ -0,0 +1,12 @@ +import GHC.IO.Encoding (setLocaleEncoding, utf8) + +import System.Environment (getArgs) +import GF.Compile.Repl (getReplOpts, runRepl) + +main :: IO () +main = do + setLocaleEncoding utf8 + args <- getArgs + case getReplOpts args of + Left errs -> mapM_ putStrLn errs + Right opts -> runRepl opts diff --git a/src/compiler/gf.cabal b/src/compiler/gf.cabal index 6135755ab..cdd18f0a8 100644 --- a/src/compiler/gf.cabal +++ b/src/compiler/gf.cabal @@ -70,6 +70,8 @@ library ghc-prim, filepath, directory>=1.2, time, process, haskeline, parallel>=3, json + build-tool-depends: alex:alex >= 3.2.4, + happy:happy >= 1.19.9 exposed-modules: GF.Interactive GF.Compiler @@ -120,6 +122,7 @@ library GF.Grammar.CanonicalJSON GF.Compile.ReadFiles GF.Compile.Rename + GF.Compile.Repl GF.Compile.SubExOpt GF.Compile.Tags GF.Compile.ToAPI @@ -200,7 +203,7 @@ library else build-depends: terminfo >=0.4.0 && < 0.5, - unix >= 2.7.2 && < 2.8 + unix >= 2.7.2 && < 2.9 if flag(server) build-depends: @@ -237,6 +240,12 @@ executable gf build-depends: base >= 4.6 && <5, directory>=1.2, gf ghc-options: -threaded +executable gfci + main-is: gf-repl.hs + default-language: Haskell2010 + build-depends: base >= 4.6 && < 5, gf + ghc-options: -threaded + test-suite gf-tests type: exitcode-stdio-1.0 main-is: run.hs