Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core

2020-10-02 19:55:24 +02:00
parent bfb94d1e48 f56fbcf86e
commit f3a8658cc1
40 changed files with 333 additions and 81 deletions
--- a/.github/workflows/build-all-versions.yml
+++ b/.github/workflows/build-all-versions.yml
@@ -0,0 +1,95 @@
+# Based on the template here: https://kodimensional.dev/github-actions
+name: Build with stack and cabal
+
+# Trigger the workflow on push or pull request, but only for the master branch
+on:
+  pull_request:
+  push:
+    branches: [master]
+
+jobs:
+  cabal:
+    name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ubuntu-latest, macOS-latest, windows-latest]
+        cabal: ["3.2"]
+        ghc:
+          - "8.6.5"
+          - "8.8.3"
+          - "8.10.1"
+        exclude:
+          - os: macOS-latest
+            ghc: 8.8.3
+          - os: macOS-latest
+            ghc: 8.6.5
+          - os: windows-latest
+            ghc: 8.8.3
+          - os: windows-latest
+            ghc: 8.6.5
+
+    steps:
+    - uses: actions/checkout@v2
+      if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
+
+    - uses: actions/setup-haskell@v1.1.1
+      id: setup-haskell-cabal
+      name: Setup Haskell
+      with:
+        ghc-version: ${{ matrix.ghc }}
+        cabal-version: ${{ matrix.cabal }}
+
+    - name: Freeze
+      run: |
+        cabal freeze
+
+    - uses: actions/cache@v1
+      name: Cache ~/.cabal/store
+      with:
+        path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+        key: ${{ runner.os }}-${{ matrix.ghc }}
+        # key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
+
+    - name: Build
+      run: |
+        cabal configure --enable-tests --enable-benchmarks --test-show-details=direct
+        cabal build all
+
+    # - name: Test
+    #   run: |
+    #     cabal test all
+
+  stack:
+    name: stack / ghc ${{ matrix.ghc }}
+    runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        stack: ["2.3.3"]
+        ghc: ["7.10.3","8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4"]
+        # ghc: ["8.8.3"]
+
+    steps:
+    - uses: actions/checkout@v2
+      if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
+
+    - uses: actions/setup-haskell@v1.1
+      name: Setup Haskell Stack
+      with:
+        # ghc-version: ${{ matrix.ghc }}
+        stack-version: ${{ matrix.stack }}
+
+    - uses: actions/cache@v1
+      name: Cache ~/.stack
+      with:
+        path: ~/.stack
+        key: ${{ runner.os }}-${{ matrix.ghc }}-stack
+
+    - name: Build
+      run: |
+        stack build --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml
+        # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
+
+    # - name: Test
+    #   run: |
+    #     stack test --system-ghc
--- a/.github/workflows/build-debian-package.yml
+++ b/.github/workflows/build-debian-package.yml
@@ -18,6 +18,7 @@ jobs:

    - name: Install build tools
      run: |
+        sudo apt update
        sudo apt install -y \
          make \
          dpkg-dev \
--- a/.gitignore
+++ b/.gitignore
@@ -6,6 +6,7 @@
 *.gfo
 *.pgf
 dist/
+dist-newstyle/
 src/runtime/c/.libs/
 src/runtime/c/Makefile
 src/runtime/c/Makefile.in
--- a/Setup.hs
+++ b/Setup.hs
@@ -19,7 +19,6 @@ main = defaultMainWithHooks simpleUserHooks
  , preInst   = gfPreInst
  , postInst  = gfPostInst
  , postCopy  = gfPostCopy
-  , sDistHook = gfSDist
  }
  where
    gfPreBuild args  = gfPre args . buildDistPref
--- a/bin/template.html
+++ b/bin/template.html
@@ -82,9 +82,10 @@ $body$
          <li><a href="http://cloud.grammaticalframework.org/">GF Cloud</a></li>
          <li>
            <a href="$rel-root$/doc/tutorial/gf-tutorial.html">Tutorial</a>
-            /
+             ·
            <a href="$rel-root$/lib/doc/rgl-tutorial/index.html">RGL Tutorial</a>
          </li>
+          <li><a href="$rel-root$/doc/gf-video-tutorials.html">Video Tutorials</a></li>
          <li><a href="$rel-root$/download"><strong>Download GF</strong></a></li>
        </ul>
      </div>
--- a/doc/gf-video-tutorials.md
+++ b/doc/gf-video-tutorials.md
@@ -0,0 +1,35 @@
+---
+title: "Video tutorials"
+---
+
+The GF [YouTube channel](https://www.youtube.com/channel/UCZ96DechSUVcXAhtOId9VVA) keeps a playlist of [all GF videos](https://www.youtube.com/playlist?list=PLrgqBB5thLeT15fUtJ8_Dtk8ppdtH90MK), and more specific playlists for narrower topics.
+If you make a video about GF, let us know and we'll add it to the suitable playlist(s)!
+
+- [General introduction to GF](#general-introduction-to-gf)
+- [Beginner resources](#beginner-resources)
+- [Resource grammar tutorials](#resource-grammar-tutorials)
+
+## General introduction to GF
+
+These videos introduce GF at a high level, and present some use cases.
+
+__Grammatical Framework: Formalizing the Grammars of the World__
+
+<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/x1LFbDQhbso" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
+
+__Aarne Ranta: Automatic Translation for Consumers and Producers__
+
+<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/An-AmFScw1o" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
+
+## Beginner resources
+
+These videos show how to install GF on your computer (Mac or Windows), and how to play with simple grammars in a [Jupyter notebook](https://github.com/GrammaticalFramework/gf-binder) (any platform, hosted at [mybinder.org](https://mybinder.org)).
+
+<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/videoseries?list=PLrgqBB5thLeRa8eViJJnjT8jBhxqCPMF2" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
+
+## Resource grammar tutorials
+
+These videos show incremental improvements to a [miniature version of the resource grammar](https://github.com/inariksit/comp-syntax-2020/tree/master/lab2/grammar/dummy#readme).
+They assume some prior knowledge of GF, roughly lessons 1-3 from the [GF tutorial](http://www.grammaticalframework.org/doc/tutorial/gf-tutorial.html).
+
+<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/videoseries?list=PLrgqBB5thLeTPkp88lnOmRtprCa8g0wX2" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
--- a/doc/tutorial/gf-tutorial.t2t
+++ b/doc/tutorial/gf-tutorial.t2t
@@ -898,7 +898,7 @@ Parentheses are only needed for grouping.
 Parsing something that is not in grammar will fail:
 ```
  > parse "hello dad"
-  Unknown words: dad
+  The parser failed at token 2: "dad"

  > parse "world hello"
  no tree found
@@ -2948,7 +2948,7 @@ We need the following combinations:
 ```
 We also need **lexical insertion**, to form phrases from single words:
 ```
-  mkCN : N -> NP ;
+  mkCN : N -> CN ;
  mkAP : A -> AP ;
 ```
 Naming convention: to construct a //C//, use a function ``mk``//C//.
@@ -2969,7 +2969,7 @@ can be built as follows:
 ```
  mkCl
    (mkNP these_Det
-       (mkCN (mkAP very_AdA (mkAP warm_A)) (mkCN pizza_CN)))
+       (mkCN (mkAP very_AdA (mkAP warm_A)) (mkCN pizza_N)))
    (mkAP italian_AP)
 ```
 The task now: to define the concrete syntax of ``Foods`` so that
@@ -3718,49 +3718,25 @@ Concrete syntax does not know if a category is a dependent type.
 ```
 Notice that the ``Kind`` argument is suppressed in linearization.

-Parsing with dependent types is performed in two phases:
+Parsing with dependent types consists of two phases:
 + context-free parsing
 + filtering through type checker

+Parsing a type-correct command works as expected:

-By just doing the first phase, the ``kind`` argument is not found:
 ```
  > parse "dim the light"
-  CAction ? dim (DKindOne light)
-```
-Moreover, type-incorrect commands are not rejected:
-```
-  > parse "dim the fan"
-  CAction ? dim (DKindOne fan)
-```
-The term ``?`` is a **metavariable**, returned by the parser
-for any subtree that is suppressed by a linearization rule.
-These are the same kind of metavariables as were used #Rsecediting
-to mark incomplete parts of trees in the syntax editor.
-
-
-
-#NEW
-
-===Solving metavariables===
-
-Use the command ``put_tree = pt`` with the option ``-typecheck``:
-```
-  > parse "dim the light" | put_tree -typecheck
  CAction light dim (DKindOne light)
 ```
-The ``typecheck`` process may fail, in which case an error message
-is shown and no tree is returned:
+However, type-incorrect commands are rejected by the typecheck:
 ```
-  > parse "dim the fan" | put_tree -typecheck
-
-  Error in tree UCommand (CAction ? 0 dim (DKindOne fan)) :
-    (? 0 <> fan) (? 0 <> light)
+  > parse "dim the fan"
+  The parsing is successful but the type checking failed with error(s):
+    Couldn't match expected type Device light
+       against the interred type Device fan
+    In the expression: DKindOne fan       
 ```

-
-
-
 #NEW

 ==Polymorphism==
@@ -3786,23 +3762,19 @@ to express Haskell-type library functions:
    \_,_,_,f,x,y -> f y x ;
 ```

-
 #NEW

 ===Dependent types: exercises===

 1. Write an abstract syntax module with above contents
 and an appropriate English concrete syntax. Try to parse the commands
-//dim the light// and //dim the fan//, with and without ``solve`` filtering.
+//dim the light// and //dim the fan//.

-
-2. Perform random and exhaustive generation, with and without
-``solve`` filtering.
+2. Perform random and exhaustive generation.

 3. Add some device kinds and actions to the grammar.


-
 #NEW

 ==Proof objects==
@@ -3912,7 +3884,6 @@ fun
 Classes for new actions can be added incrementally.


-
 #NEW

 ==Variable bindings==
@@ -4200,7 +4171,8 @@ We construct a calculator with addition, subtraction, multiplication, and
 division of integers.
 ```
  abstract Calculator = {
-
+  flags startcat = Exp ;
+  
  cat Exp ;

  fun
@@ -4226,7 +4198,7 @@ We begin with a
 concrete syntax that always uses parentheses around binary
 operator applications:
 ```
-  concrete CalculatorP of Calculator = {
+  concrete CalculatorP of Calculator = open Prelude in {

  lincat
    Exp = SS ;
--- a/gf.cabal
+++ b/gf.cabal
@@ -82,6 +82,10 @@ Library
                 pretty,
                 mtl,
                 exceptions,
+                 fail,
+                 -- For compatability with ghc < 8
+                 -- We need transformers-compat >= 0.6.3, but that is only in newer snapshots where it is redundant.
+                 transformers-compat,
                 ghc-prim
  hs-source-dirs: src/runtime/haskell

@@ -98,8 +102,6 @@ Library
 --if impl(ghc>=7.8)
 --  ghc-options: +RTS -A20M -RTS
  ghc-prof-options: -fprof-auto
-  if impl(ghc>=8.6)
-    Default-extensions: NoMonadFailDesugaring

  exposed-modules:
    PGF
--- a/index.html
+++ b/index.html
@@ -39,7 +39,7 @@
        /
        <a href="lib/doc/rgl-tutorial/index.html">RGL Tutorial</a>
      </li>
-      <li><a href="https://www.youtube.com/playlist?list=PL4L18Hhub0qFgLgFmzE4h-FxqemBcvWSW">Video Tutorial</a></li>
+      <li><a href="doc/gf-video-tutorials.html">Video Tutorials</a></li>
    </ul>

    <a href="download/index.html" class="btn btn-primary ml-3">
@@ -56,6 +56,7 @@
      <li><a href="doc/gf-refman.html">Reference Manual</a></li>
      <li><a href="doc/gf-shell-reference.html">Shell Reference</a></li>
      <li><a href="http://www.molto-project.eu/sites/default/files/MOLTO_D2.3.pdf">Best Practices</a> <small>[PDF]</small></li>
+      <li><a href="https://www.mitpressjournals.org/doi/pdf/10.1162/COLI_a_00378">Scaling Up (Computational Linguistics 2020)</a></li>
    </ul>

    <a href="lib/doc/synopsis/index.html" class="btn btn-primary ml-3">
@@ -173,6 +174,7 @@ least one, it may help you to get a first idea of what GF is.
    <li>macOS</li>
    <li>Windows</li>
    <li>Android mobile platform (via Java; runtime)</li>
+    <li>iOS mobile platform (iPhone, iPad)</li>
    <li>via compilation to JavaScript, almost any platform that has a web browser (runtime)</li>
    </ul>

@@ -226,6 +228,10 @@ least one, it may help you to get a first idea of what GF is.
    <h2>News</h2>

    <dl class="row">
+      <dt class="col-sm-3 text-center text-nowrap">2020-09-29</dt>
+      <dd class="col-sm-9">
+        <a href="https://www.mitpressjournals.org/doi/pdf/10.1162/COLI_a_00378">Abstract Syntax as Interlingua</a>: Scaling Up the Grammatical Framework from Controlled Languages to Robust Pipelines. A paper in Computational Linguistics (2020) summarizing much of the development in GF in the past ten years.
+      </dd>
      <dt class="col-sm-3 text-center text-nowrap">2020-03-29</dt>
      <dd class="col-sm-9">
        <a href="//school.grammaticalframework.org/2020/">Seventh GF Summer School</a> in Singapore has been postponed because of the corona pandemic.
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -34,6 +34,7 @@ import Data.Maybe
 import qualified Data.Map as Map
 import GF.Text.Pretty
 import Data.List (sort)
+import qualified Control.Monad.Fail as Fail
 --import Debug.Trace


@@ -44,7 +45,7 @@ pgfEnv pgf = Env pgf mos

 class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv

-instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
+instance (Monad m,HasPGFEnv m,Fail.MonadFail m) => TypeCheckArg m where
  typeCheckArg e = (either (fail . render . ppTcError) (return . fst)
                    . flip inferExpr e . pgf) =<< getPGFEnv

--- a/src/compiler/GF/Command/Commands2.hs
+++ b/src/compiler/GF/Command/Commands2.hs
@@ -18,6 +18,7 @@ import Data.Maybe
 import qualified Data.Map as Map
 import GF.Text.Pretty
 import Control.Monad(mplus)
+import qualified Control.Monad.Fail as Fail


 data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr}
@@ -25,7 +26,7 @@ data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr}
 pgfEnv pgf = Env (Just pgf) (languages pgf)
 emptyPGFEnv = Env Nothing Map.empty

-class (Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
+class (Fail.MonadFail m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv

 instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
  typeCheckArg e = do env <- getPGFEnv
--- a/src/compiler/GF/Command/Interpreter.hs
+++ b/src/compiler/GF/Command/Interpreter.hs
@@ -11,6 +11,8 @@ import GF.Infra.UseIO(putStrLnE)

 import Control.Monad(when)
 import qualified Data.Map as Map
+import GF.Infra.UseIO (Output)
+import qualified Control.Monad.Fail as Fail

 data CommandEnv m = CommandEnv {
  commands      :: Map.Map String (CommandInfo m),
@@ -22,6 +24,7 @@ data CommandEnv m = CommandEnv {
 mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty

 --interpretCommandLine :: CommandEnv -> String -> SIO ()
+interpretCommandLine :: (Fail.MonadFail m, Output m, TypeCheckArg m) => CommandEnv m -> String -> m ()
 interpretCommandLine env line =
  case readCommandLine line of
    Just []    -> return ()
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -41,6 +41,7 @@ import Control.Monad
 import Control.Monad.Identity
 --import Control.Exception
 --import Debug.Trace(trace)
+import qualified Control.Monad.Fail as Fail

 ----------------------------------------------------------------------
 -- main conversion function
@@ -196,6 +197,9 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar
                              -> ([ProtoFCat],[Symbol])
                              -> Branch b}

+instance Fail.MonadFail CnvMonad where
+  fail = bug
+
 instance Applicative CnvMonad where
  pure = return
  (<*>) = ap
--- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module GF.Compile.TypeCheck.ConcreteNew( checkLType, inferLType ) where

 -- The code here is based on the paper:
@@ -19,6 +20,7 @@ import GF.Text.Pretty
 import Data.List (nub, (\\), tails)
 import qualified Data.IntMap as IntMap
 import Data.Maybe(fromMaybe,isNothing)
+import qualified Control.Monad.Fail as Fail

 checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type)
 checkLType ge t ty = runTcM $ do
@@ -646,8 +648,16 @@ instance Monad TcM where
  f >>= g  = TcM (\ms msgs -> case unTcM f ms msgs of
                                TcOk x ms msgs -> unTcM (g x) ms msgs
                                TcFail    msgs -> TcFail msgs)
+
+#if !(MIN_VERSION_base(4,13,0))
+  -- Monad(fail) will be removed in GHC 8.8+
+  fail = Fail.fail
+#endif
+
+instance Fail.MonadFail TcM where
  fail     = tcError . pp

+
 instance Applicative TcM where
  pure = return
  (<*>) = ap
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -27,9 +27,10 @@ import Data.List
 import qualified Data.Map as Map
 import Control.Monad
 import GF.Text.Pretty
+import qualified Control.Monad.Fail as Fail

 -- | combine a list of definitions into a balanced binary search tree
-buildAnyTree :: Monad m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
+buildAnyTree :: Fail.MonadFail m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
 buildAnyTree m = go Map.empty
  where
    go map []         = return map
--- a/src/compiler/GF/CompileInParallel.hs
+++ b/src/compiler/GF/CompileInParallel.hs
@@ -20,6 +20,8 @@ import GF.Infra.Ident(moduleNameS)
 import GF.Text.Pretty
 import GF.System.Console(TermColors(..),getTermColors)
 import qualified Data.ByteString.Lazy as BS
+-- Control.Monad.Fail import will become redundant in GHC 8.8+
+import qualified Control.Monad.Fail as Fail

 -- | Compile the given grammar files and everything they depend on,
 -- like 'batchCompile'. This function compiles modules in parallel.
@@ -256,6 +258,9 @@ instance Output m => Output (CollectOutput m) where
  putStrLnE s = CO (return (putStrLnE s,()))
  putStrE   s = CO (return (putStrE s,()))

+instance Fail.MonadFail m => Fail.MonadFail (CollectOutput m) where
+  fail = CO . fail
+
 instance ErrorMonad m => ErrorMonad (CollectOutput m) where
  raise e = CO (raise e)
  handle (CO m) h = CO $ handle m (unCO . h)
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -30,12 +30,13 @@ import qualified Data.Map as Map
 import GF.Text.Pretty(render,(<+>),($$)) --Doc,
 import GF.System.Console(TermColors(..),getTermColors)
 import Control.Monad((<=<))
+import qualified Control.Monad.Fail as Fail

 type OneOutput = (Maybe FullPath,CompiledModule)
 type CompiledModule = Module

 compileOne, reuseGFO, useTheSource ::
-    (Output m,ErrorMonad m,MonadIO m) =>
+    (Output m,ErrorMonad m,MonadIO m, Fail.MonadFail m) =>
    Options -> Grammar -> FullPath -> m OneOutput

 -- | Compile a given source file (or just load a .gfo file),
--- a/src/compiler/GF/Data/BacktrackM.hs
+++ b/src/compiler/GF/Data/BacktrackM.hs
@@ -13,6 +13,7 @@
 -----------------------------------------------------------------------------

 {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
 module GF.Data.BacktrackM (
                    -- * the backtracking state monad
 		    BacktrackM,
@@ -32,6 +33,7 @@ import Data.List
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State.Class
+import qualified Control.Monad.Fail as Fail

 ----------------------------------------------------------------------
 -- Combining endomorphisms and continuations
@@ -69,6 +71,12 @@ instance Monad (BacktrackM s) where
    return a   = BM (\c s b -> c a s b)
    BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
 	where unBM (BM m) = m
+
+#if !(MIN_VERSION_base(4,13,0))
+    fail = Fail.fail
+#endif
+
+instance Fail.MonadFail (BacktrackM s) where
    fail _ = mzero

 instance Functor (BacktrackM s) where
--- a/src/compiler/GF/Data/ErrM.hs
+++ b/src/compiler/GF/Data/ErrM.hs
@@ -12,10 +12,12 @@
 -- hack for BNFC generated files. AR 21/9/2003
 -----------------------------------------------------------------------------

+{-# LANGUAGE CPP #-}
 module GF.Data.ErrM where

 import Control.Monad (MonadPlus(..),ap)
 import Control.Applicative
+import qualified Control.Monad.Fail as Fail

 -- | Like 'Maybe' type with error msgs
 data Err a = Ok a | Bad String
@@ -33,10 +35,19 @@ fromErr a = err (const a) id

 instance Monad Err where
  return      = Ok
-  fail        = Bad
  Ok a  >>= f = f a
  Bad s >>= f = Bad s

+#if !(MIN_VERSION_base(4,13,0))
+  -- Monad(fail) will be removed in GHC 8.8+
+  fail = Fail.fail
+#endif
+
+instance Fail.MonadFail Err where
+  fail        = Bad
+
+
+
 -- | added 2\/10\/2003 by PEB
 instance Functor Err where
  fmap f (Ok a) = Ok (f a)
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -53,6 +53,7 @@ import Control.Monad (liftM,liftM2) --,ap

 import GF.Data.ErrM
 import GF.Data.Relation
+import qualified Control.Monad.Fail as Fail

 infixr 5 +++
 infixr 5 ++-
@@ -88,10 +89,10 @@ checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where
  overloaded s = length (filter (==s) ss) > 1

 -- | this is what happens when matching two values in the same module
-unifyMaybe :: (Eq a, Monad m) => Maybe a -> Maybe a -> m (Maybe a)
+unifyMaybe :: (Eq a, Fail.MonadFail m) => Maybe a -> Maybe a -> m (Maybe a)
 unifyMaybe = unifyMaybeBy id

-unifyMaybeBy :: (Eq b, Monad m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
+unifyMaybeBy :: (Eq b, Fail.MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
 unifyMaybeBy f (Just p1) (Just p2)
  | f p1==f p2                     = return (Just p1)
  | otherwise                      = fail ""
--- a/src/compiler/GF/Grammar/CanonicalJSON.hs
+++ b/src/compiler/GF/Grammar/CanonicalJSON.hs
@@ -6,6 +6,7 @@ import Text.JSON
 import Control.Applicative ((<|>))
 import Data.Ratio (denominator, numerator)
 import GF.Grammar.Canonical
+import Control.Monad (guard)


 encodeJSON :: FilePath -> Grammar -> IO ()
@@ -126,10 +127,10 @@ instance JSON LinType where
  -- records are encoded as records:
  showJSON (RecordType rows) = showJSON rows

-  readJSON o = do "Str"   <- readJSON o; return StrType
-    <|>        do "Float" <- readJSON o; return FloatType
-    <|>        do "Int"   <- readJSON o; return IntType
-    <|>        do  ptype  <- readJSON o; return (ParamType ptype)
+  readJSON o = StrType   <$ parseString "Str"   o
+    <|>        FloatType <$ parseString "Float" o
+    <|>        IntType   <$ parseString "Int"   o
+    <|>        ParamType <$> readJSON o
    <|>        TableType  <$> o!".tblarg" <*> o!".tblval"
    <|>        TupleType  <$> o!".tuple"
    <|>        RecordType <$> readJSON o
@@ -186,7 +187,7 @@ instance JSON LinPattern where
  -- and records as records:
  showJSON (RecordPattern r) = showJSON r

-  readJSON o = do "_" <- readJSON o; return WildPattern
+  readJSON o = do  p  <- parseString "_" o; return WildPattern
    <|>        do  p  <- readJSON o; return (ParamPattern (Param p []))
    <|>        ParamPattern  <$> readJSON o
    <|>        RecordPattern <$> readJSON o
@@ -237,7 +238,7 @@ instance JSON VarId where
  showJSON Anonymous = showJSON "_"
  showJSON (VarId x) = showJSON x

-  readJSON o = do "_" <- readJSON o; return Anonymous
+  readJSON o = do parseString "_" o; return Anonymous
    <|>        VarId <$> readJSON o

 instance JSON QualId where
@@ -268,6 +269,9 @@ instance JSON FlagValue where
 --------------------------------------------------------------------------------
 -- ** Convenience functions

+parseString :: String -> JSValue -> Result ()
+parseString s o = guard . (== s) =<< readJSON o
+
 (!) :: JSON a => JSValue -> String -> Result a
 obj ! key = maybe (fail $ "CanonicalJSON.(!): Could not find key: " ++ show key)
            readJSON
--- a/src/compiler/GF/Grammar/Lexer.x
+++ b/src/compiler/GF/Grammar/Lexer.x
@@ -1,5 +1,6 @@
 -- -*- haskell -*-
 {
+{-# LANGUAGE CPP #-}
 module GF.Grammar.Lexer
         ( Token(..), Posn(..)
         , P, runP, runPartial, token, lexer, getPosn, failLoc
@@ -18,6 +19,7 @@ import qualified Data.Map as Map
 import Data.Word(Word8)
 import Data.Char(readLitChar)
 --import Debug.Trace(trace)
+import qualified Control.Monad.Fail as Fail
 }


@@ -282,8 +284,12 @@ instance Monad P where
  (P m) >>= k = P $ \ s -> case m s of
                             POk s a          -> unP (k a) s
                             PFailed posn err -> PFailed posn err
+
+
+instance Fail.MonadFail P where
  fail msg    = P $ \(_,AI posn _ _) -> PFailed posn msg

+
 runP :: P a -> BS.ByteString -> Either (Posn,String) a
 runP p bs = snd <$> runP' p (Pn 1 0,bs)

--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -32,6 +32,7 @@ import Control.Monad (liftM, liftM2, liftM3)
 import Data.List (sortBy,nub)
 import Data.Monoid
 import GF.Text.Pretty(render,(<+>),hsep,fsep)
+import qualified Control.Monad.Fail as Fail

 -- ** Functions for constructing and analysing source code terms.

@@ -237,7 +238,7 @@ isPredefConstant t = case t of
  Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
  _                                               -> False

-checkPredefError :: Monad m => Term -> m Term
+checkPredefError :: Fail.MonadFail m => Term -> m Term
 checkPredefError t =
    case t of
      Error s -> fail ("Error: "++s)
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -32,6 +32,7 @@ import System.FilePath(makeRelative)
 import Control.Parallel.Strategies(parList,rseq,using)
 import Control.Monad(liftM,ap)
 import Control.Applicative(Applicative(..))
+import qualified Control.Monad.Fail as Fail

 type Message = Doc
 type Error   = Message
@@ -53,6 +54,9 @@ instance Monad Check where
                 (ws,Success x) -> unCheck (g x) {-ctxt-} ws
                 (ws,Fail msg)  -> (ws,Fail msg)

+instance Fail.MonadFail Check where
+  fail = raise
+
 instance Applicative Check where
  pure = return
  (<*>) = ap
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -44,6 +44,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set

 import PGF.Internal(Literal(..))
+import qualified Control.Monad.Fail as Fail

 usageHeader :: String
 usageHeader = unlines 
@@ -548,7 +549,7 @@ lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs]
 lookupReadsPrec :: [(String,a)] -> Int -> ReadS a
 lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x]

-onOff :: Monad m => (Bool -> m a) -> Bool -> ArgDescr (m a)
+onOff :: Fail.MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a)
 onOff f def = OptArg g "[on,off]"
  where g ma = maybe (return def) readOnOff ma >>= f
        readOnOff x = case map toLower x of
@@ -556,7 +557,7 @@ onOff f def = OptArg g "[on,off]"
                        "off" -> return False
                        _     -> fail $ "Expected [on,off], got: " ++ show x

-readOutputFormat :: Monad m => String -> m OutputFormat
+readOutputFormat :: Fail.MonadFail m => String -> m OutputFormat
 readOutputFormat s = 
    maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats

--- a/src/compiler/GF/Infra/SIO.hs
+++ b/src/compiler/GF/Infra/SIO.hs
@@ -42,6 +42,7 @@ import qualified GF.Command.Importing as GF(importGrammar, importSource)
 #ifdef C_RUNTIME
 import qualified PGF2
 #endif
+import qualified Control.Monad.Fail as Fail

 -- * The SIO monad

@@ -58,6 +59,9 @@ instance Monad SIO where
  return x = SIO (const (return x))
  SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h

+instance Fail.MonadFail SIO where
+  fail = liftSIO . fail
+
 instance Output SIO where
  ePutStr = lift0 . ePutStr
  ePutStrLn = lift0 . ePutStrLn
--- a/src/compiler/GF/Infra/UseIO.hs
+++ b/src/compiler/GF/Infra/UseIO.hs
@@ -159,6 +159,9 @@ instance ErrorMonad IO where
                                then h (ioeGetErrorString e)
                                else ioError e
 {-
+-- Control.Monad.Fail import will become redundant in GHC 8.8+
+import qualified Control.Monad.Fail as Fail
+
 instance Functor IOE where fmap = liftM

 instance Applicative IOE where
@@ -170,7 +173,15 @@ instance  Monad IOE where
  IOE c >>= f = IOE $ do 
                  x <- c          -- Err a
                  appIOE $ err raise f x         -- f :: a -> IOE a
+
+ #if !(MIN_VERSION_base(4,13,0))
  fail = raise
+ #endif
+
+instance Fail.MonadFail IOE where
+  fail = raise
+
+
 -}

 -- | Print the error message and return a default value if the IO operation 'fail's
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -38,6 +38,9 @@ import GF.Server(server)
 #endif

 import GF.Command.Messages(welcome)
+import GF.Infra.UseIO (Output)
+-- Provides an orphan instance of MonadFail for StateT in ghc versions < 8
+import Control.Monad.Trans.Instances ()

 -- | Run the GF Shell in quiet mode (@gf -run@).
 mainRunGFI :: Options -> [FilePath] -> IO ()
@@ -99,7 +102,7 @@ timeIt act =

 -- | Optionally show how much CPU time was used to run an IO action
 optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
-optionallyShowCPUTime opts act 
+optionallyShowCPUTime opts act
  | not (verbAtLeast opts Normal) = act
  | otherwise = do (dt,r) <- timeIt act
                   liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
@@ -363,7 +366,7 @@ wordCompletion gfenv (left,right) = do
    pgf    = multigrammar gfenv
    cmdEnv = commandenv gfenv
    optLang opts = valCIdOpts "lang" (head (languages pgf)) opts
-    optType opts = 
+    optType opts =
      let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts
      in case readType str of
           Just ty -> ty
@@ -410,7 +413,7 @@ wc_type = cmd_name
    option x y (c  :cs)
      | isIdent c       = option x y cs
      | otherwise       = cmd x cs
-      
+
    optValue x y ('"':cs) = str x y cs
    optValue x y cs       = cmd x cs

@@ -428,7 +431,7 @@ wc_type = cmd_name
      where
        x1 = take (length x - length y - d) x
        x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
-        
+
        cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
 	        [x] -> Just x
                _   -> Nothing
--- a/src/runtime/haskell-bind/CHANGELOG.md
+++ b/src/runtime/haskell-bind/CHANGELOG.md
@@ -1,3 +1,8 @@
+## 1.2.1
+
+- Remove deprecated pgf_print_expr_tuple
+- Added an API for cloning expressions/types/literals
+
 ## 1.2.0

 - Stop `pgf-shell` from being built by default.
--- a/src/runtime/haskell-bind/HACKAGE.md
+++ b/src/runtime/haskell-bind/HACKAGE.md
@@ -0,0 +1,10 @@
+# Instructions for uploading to Hackage
+
+You will need a Hackage account for steps 4 & 5.
+
+1. Bump the version number in `pgf2.cabal`
+2. Add details in `CHANGELOG.md`
+3. Run `stack sdist` (or `cabal sdist`)
+4. Visit `https://hackage.haskell.org/upload` and upload the file `./.stack-work/dist/x86_64-osx/Cabal-2.2.0.1/pgf2-x.y.z.tar.gz` (or Cabal equivalent)
+5. If successful, upload documentation with `./stack-haddock-upload.sh pgf2 x.y.z` (compilation on Hackage's servers will fail because of missing C libraries)
+6. Commit and push to this repository (`gf-core`)
--- a/src/runtime/haskell-bind/pgf2.cabal
+++ b/src/runtime/haskell-bind/pgf2.cabal
@@ -1,5 +1,5 @@
 name: pgf2
-version: 1.2.0
+version: 1.2.1
 synopsis: Bindings to the C version of the PGF runtime
 description:
  GF, Grammatical Framework, is a programming language for multilingual grammar applications.
--- a/src/runtime/haskell/Data/Binary/Get.hs
+++ b/src/runtime/haskell/Data/Binary/Get.hs
@@ -101,6 +101,10 @@ import GHC.Word
 --import GHC.Int
 #endif

+-- Control.Monad.Fail import will become redundant in GHC 8.8+
+import qualified Control.Monad.Fail as Fail
+
+
 -- | The parse state
 data S = S {-# UNPACK #-} !B.ByteString  -- current chunk
           L.ByteString                  -- the rest of the input
@@ -126,6 +130,11 @@ instance Monad Get where
                             (a, s') -> unGet (k a) s')
    {-# INLINE (>>=) #-}

+#if !(MIN_VERSION_base(4,13,0))
+    fail      = failDesc
+#endif
+
+instance Fail.MonadFail Get where
    fail      = failDesc

 instance MonadFix Get where
--- a/src/server/CGI.hs
+++ b/src/server/CGI.hs
@@ -4,7 +4,7 @@ import Network.CGI as C(
       CGI,ContentType(..),Accept(..),Language(..),
       getVarWithDefault,readInput,negotiate,requestAcceptLanguage,getInput,
       setHeader,output,outputFPS,outputError,
-       handleErrors,catchCGI,throwCGI,
+       handleErrors,
       liftIO)
 import Network.CGI.Protocol as C(CGIResult(..),CGIRequest(..),Input(..),
                                 Headers,HeaderName(..))
--- a/src/server/CGIUtils.hs
+++ b/src/server/CGIUtils.hs
@@ -15,11 +15,14 @@ import System.Posix
 #endif

 import CGI(CGI,CGIResult,setHeader,output,outputFPS,outputError,
-           getInput,catchCGI,throwCGI)
+           getInput)

 import Text.JSON
 import qualified Codec.Binary.UTF8.String as UTF8 (encodeString)
 import qualified Data.ByteString.Lazy as BS
+import Control.Monad.Catch (MonadThrow(throwM))
+import Network.CGI.Monad (catchCGI)
+import Control.Monad.Catch (MonadCatch(catch))

 -- * Logging

@@ -53,11 +56,11 @@ instance Exception CGIError where
  fromException (SomeException e) = cast e

 throwCGIError :: Int -> String -> [String] -> CGI a
-throwCGIError c m t = throwCGI $ toException $ CGIError c m t
+throwCGIError c m t = throwM $ toException $ CGIError c m t

 handleCGIErrors :: CGI CGIResult -> CGI CGIResult
 handleCGIErrors x =
-    x `catchCGI` \e -> case fromException e of
+    x `catch` \e -> case fromException e of
                         Nothing -> throw e
                         Just (CGIError c m t) -> do setXO; outputError c m t

--- a/src/tools/c/GFCC/ErrM.hs
+++ b/src/tools/c/GFCC/ErrM.hs
@@ -4,6 +4,10 @@
 -- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
 module GFCC.ErrM where

+-- Control.Monad.Fail import will become redundant in GHC 8.8+
+import qualified Control.Monad.Fail as Fail
+
+
 -- the Error monad: like Maybe type with error msgs

 data Err a = Ok a | Bad String
@@ -11,6 +15,13 @@ data Err a = Ok a | Bad String

 instance Monad Err where
  return      = Ok
-  fail        = Bad
  Ok a  >>= f = f a
  Bad s >>= f = Bad s
+
+#if !(MIN_VERSION_base(4,13,0))
+  fail        = Bad
+#endif
+
+instance Fail.MonadFail Err where
+  fail        = Bad
+
--- a/stack-ghc7.10.3.yaml
+++ b/stack-ghc7.10.3.yaml
@@ -1 +1,12 @@
 resolver: lts-6.35 # ghc 7.10.3
+
+extra-deps:
+- happy-1.19.9
+- alex-3.2.4
+- transformers-compat-0.6.5
+
+allow-newer: true
+
+flags:
+  transformers-compat:
+    four: true
--- a/stack-ghc8.6.5.yaml
+++ b/stack-ghc8.6.5.yaml
@@ -1,5 +1,6 @@
-resolver: lts-14.3 # ghc 8.6.5
+resolver: lts-14.27 # ghc 8.6.5

 extra-deps:
 - network-2.6.3.6
 - httpd-shed-0.4.0.3
+- cgi-3001.5.0.0
--- a/stack-ghc8.8.4.yaml
+++ b/stack-ghc8.8.4.yaml
@@ -0,0 +1,9 @@
+resolver: lts-16.13 # ghc 8.8.4
+
+extra-deps:
+- network-2.6.3.6
+- httpd-shed-0.4.0.3
+- cgi-3001.5.0.0@sha256:3d1193a328d5f627a021a0ef3927c1ae41dd341e32dba612fed52d0e3a6df056,2990
+- json-0.10@sha256:d9fc6b07ce92b8894825a17d2cf14799856767eb30c8bf55962baa579207d799,3210
+- multipart-0.2.0@sha256:b8770e3ff6089be4dd089a8250894b31287cca671f3d258190a505f9351fa8a9,1084
+
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,9 +1,9 @@
-# This default stack file is a copy of stack-ghc8.2.2.yaml
+# This default stack file is a copy of stack-ghc8.6.5.yaml
 # But committing a symlink is probably a bad idea, so it's a real copy

-resolver: lts-11.22 # ghc 8.2.2
+resolver: lts-14.27 # ghc 8.6.5

 extra-deps:
- cgi-3001.3.0.3
+- network-2.6.3.6
 - httpd-shed-0.4.0.3
- exceptions-0.10.2
+- cgi-3001.5.0.0
--- a/testsuite/run.hs
+++ b/testsuite/run.hs
@@ -1,6 +1,7 @@
 import Data.List(partition)
 import System.IO
 import Distribution.Simple.BuildPaths(exeExtension)
+import Distribution.System ( buildPlatform )
 import System.Process(readProcess)
 import System.Directory(doesFileExist,getDirectoryContents)
 import System.FilePath((</>),(<.>),takeExtension)
@@ -71,7 +72,7 @@ main =

 -- Should consult the Cabal configuration!
 run_gf = readProcess default_gf ["-run","-gf-lib-path="++gf_lib_path]
-default_gf = "dist/build/gf/gf"<.>exeExtension
+default_gf = "dist/build/gf/gf"<.>exeExtension buildPlatform
 gf_lib_path = "dist/build/rgl"

 -- | List files, excluding "." and ".."