replace aeson with json

5 files changed, 103 insertions, 293 deletions

diff --git a/gf.cabal b/gf.cabal
index 2d956271a..191d2c0e5 100644
--- a/gf.cabal
+++ b/gf.cabal
@@ -143,8 +143,7 @@ Library
 ---- GF compiler as a library:
 
   build-depends: filepath, directory, time, time-compat,
-                 process, haskeline, parallel>=3,
-                 aeson>=1.3, yaml, unordered-containers, scientific, text
+                 process, haskeline, parallel>=3
 
   hs-source-dirs: src/compiler
   exposed-modules:
diff --git a/src/compiler/GF/Compile/Export.hs b/src/compiler/GF/Compile/Export.hs
index e1895feb0..e0811d40d 100644
--- a/src/compiler/GF/Compile/Export.hs
+++ b/src/compiler/GF/Compile/Export.hs
@@ -37,7 +37,6 @@ exportPGF opts fmt pgf =
       FmtPGFPretty    -> multi "txt" (render . ppPGF)
       FmtCanonicalGF  -> [] -- canon "gf" (render80 . abstract2canonical)
       FmtCanonicalJson-> []
-      FmtCanonicalYaml-> []
       FmtJavaScript   -> multi "js"  pgf2js
       FmtPython       -> multi "py"  pgf2python
       FmtHaskell      -> multi "hs"  (grammar2haskell opts name)
diff --git a/src/compiler/GF/Compiler.hs b/src/compiler/GF/Compiler.hs
index 539b0b341..efb1ae70f 100644
--- a/src/compiler/GF/Compiler.hs
+++ b/src/compiler/GF/Compiler.hs
@@ -24,7 +24,7 @@ import Data.Maybe
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.ByteString.Lazy as BSL
-import GF.Grammar.CanonicalJSON (encodeJSON, encodeYAML)
+import GF.Grammar.CanonicalJSON (encodeJSON)
 import System.FilePath
 import Control.Monad(when,unless,forM_)
 
@@ -65,7 +65,6 @@ compileSourceFiles opts fs =
               mapM_ abs2canonical canonical
               mapM_ cnc2canonical canonical
          when (FmtCanonicalJson `elem` ofmts) $ mapM_ grammar2json canonical
-         when (FmtCanonicalYaml `elem` ofmts) $ mapM_ grammar2yaml canonical
       where
         ofmts = flag optOutputFormats opts
 
@@ -86,10 +85,6 @@ compileSourceFiles opts fs =
       where absname = srcAbsName gr cnc
             gr_canon = grammar2canonical opts absname gr
 
-    grammar2yaml (cnc,gr) = encodeYAML (render absname ++ ".yaml") gr_canon
-      where absname = srcAbsName gr cnc
-            gr_canon = grammar2canonical opts absname gr
-
     writeExport (path,s) = writing opts path $ writeUTF8File path s
 
 
diff --git a/src/compiler/GF/Grammar/CanonicalJSON.hs b/src/compiler/GF/Grammar/CanonicalJSON.hs
index 39cd32e80..d791e0d9b 100644
--- a/src/compiler/GF/Grammar/CanonicalJSON.hs
+++ b/src/compiler/GF/Grammar/CanonicalJSON.hs
@@ -1,35 +1,14 @@
-{-# language OverloadedStrings, OverloadedLists #-}
-
 module GF.Grammar.CanonicalJSON (
-  encodeJSON, encodeYAML,
-  decodeJSON, decodeYAML
+  encodeJSON
   ) where
 
-
+import Text.JSON
 import qualified Control.Monad       as CM    (mapM, msum)
-import qualified Data.HashMap.Strict as HM    (toList)
-import qualified Data.Yaml           as Yaml  (encodeFile, decodeFileEither, ParseException)
-import qualified Data.Aeson          as Aeson (encodeFile, eitherDecodeFileStrict')
-import Data.Aeson                             (ToJSON(..), object, (.=))
-import Data.Aeson                             (FromJSON(..), Value(..), withObject, (.:), (.:?), (.!=))
-import Data.Aeson.Types                       (typeMismatch, modifyFailure, Pair, Parser)
-import Data.Text                              (Text, pack, unpack)
-import Data.Scientific                        (floatingOrInteger)
-
 import GF.Grammar.Canonical
 
 
 encodeJSON :: FilePath -> Grammar -> IO ()
-encodeJSON = Aeson.encodeFile
-
-encodeYAML :: FilePath -> Grammar -> IO ()
-encodeYAML = Yaml.encodeFile
-
-decodeJSON :: FilePath -> IO (Either String Grammar)
-decodeJSON = Aeson.eitherDecodeFileStrict'
-
-decodeYAML :: FilePath -> IO (Either Yaml.ParseException Grammar)
-decodeYAML = Yaml.decodeFileEither
+encodeJSON fpath g = writeFile fpath (encode g)
 
 
 -- in general we encode grammars using JSON objects/records,
@@ -38,317 +17,157 @@ decodeYAML = Yaml.decodeFileEither
 -- the top-level definitions use normal record labels,
 -- but recursive types/values/ids use labels staring with a "."
 
-instance ToJSON Grammar where
-  toJSON (Grammar abs cncs) = object ["abstract" .= abs, "concretes" .= cncs]
-
-instance FromJSON Grammar where
-  parseJSON = withObject "Grammar" $ \o -> Grammar <$> o .: "abstract" <*> o .: "concretes"
+instance JSON Grammar where
+  showJSON (Grammar abs cncs) = makeObj [("abstract", showJSON abs), ("concretes", showJSON cncs)]
 
 
 --------------------------------------------------------------------------------
 -- ** Abstract Syntax
 
-instance ToJSON Abstract where
-  toJSON (Abstract absid flags cats funs) 
-    = object ["abs"   .= absid,
-              "flags" .= flags,
-              "cats"  .= cats,
-              "funs"  .= funs]
+instance JSON Abstract where
+  showJSON (Abstract absid flags cats funs) 
+    = makeObj [("abs", showJSON absid),
+               ("flags", showJSON flags),
+               ("cats", showJSON cats),
+               ("funs", showJSON funs)]
 
-instance FromJSON Abstract where
-  parseJSON = withObject "Abstract" $ \o -> Abstract
-    <$> o .:  "abs"
-    <*> o .:? "flags" .!= Flags []
-    <*> o .:  "cats"
-    <*> o .:  "funs"
-
-
-instance ToJSON CatDef where
+instance JSON CatDef where
   -- non-dependent categories are encoded as simple strings:
-  toJSON (CatDef c []) = toJSON c
-  toJSON (CatDef c cs) = object ["cat" .= c, "args" .= cs]
-
-instance FromJSON CatDef where
-  parseJSON (String s) = return $ CatDef (CatId (unpack s)) []
-  parseJSON (Object o) = CatDef <$> o .: "cat" <*> o .: "args"
-  parseJSON val        = typeMismatch "CatDef" val
-
-
-instance ToJSON FunDef where
-  toJSON (FunDef f ty) = object ["fun" .= f, "type" .= ty]
+  showJSON (CatDef c []) = showJSON c
+  showJSON (CatDef c cs) = makeObj [("cat", showJSON c), ("args", showJSON cs)]
 
+instance JSON FunDef where
+  showJSON (FunDef f ty) = makeObj [("fun", showJSON f), ("type", showJSON ty)]
+{-
 instance FromJSON FunDef where
   parseJSON = withObject "FunDef" $ \o -> FunDef <$> o .: "fun" <*> o .: "type"
+-}
 
+instance JSON Type where
+  showJSON (Type bs ty) = makeObj [("args", showJSON bs), ("result", showJSON ty)]
 
-instance ToJSON Type where
-  toJSON (Type bs ty) = object [".args" .= bs, ".result" .= ty]
-
-instance FromJSON Type where
-  parseJSON = withObject "Type" $ \o -> Type <$> o .: ".args" <*> o .: ".result"
-
-
-instance ToJSON TypeApp where
+instance JSON TypeApp where
   -- non-dependent categories are encoded as simple strings:
-  toJSON (TypeApp c [])   = toJSON c
-  toJSON (TypeApp c args) = object [".cat" .= c, ".args" .= args]
-
-instance FromJSON TypeApp where
-  parseJSON (String s) = return $ TypeApp (CatId (unpack s)) []
-  parseJSON (Object o) = TypeApp <$> o .: ".cat" <*> o .: ".args"
-  parseJSON val        = typeMismatch "TypeApp" val
+  showJSON (TypeApp c [])   = showJSON c
+  showJSON (TypeApp c args) = makeObj [("cat", showJSON c), ("args", showJSON args)]
 
-
-instance ToJSON TypeBinding where
+instance JSON TypeBinding where
   -- non-dependent categories are encoded as simple strings:
-  toJSON (TypeBinding Anonymous (Type [] (TypeApp c []))) = toJSON c
-  toJSON (TypeBinding x ty) = object [".var" .= x, ".type" .= ty]
-
-instance FromJSON TypeBinding where
-  parseJSON (String s) = return $ TypeBinding Anonymous (Type [] (TypeApp (CatId (unpack s)) []))
-  parseJSON (Object o) = TypeBinding <$> o .: ".var" <*> o .: ".type"
-  parseJSON val        = typeMismatch "TypeBinding" val
+  showJSON (TypeBinding Anonymous (Type [] (TypeApp c []))) = showJSON c
+  showJSON (TypeBinding x ty) = makeObj [("var", showJSON x), ("type", showJSON ty)]
 
 
 --------------------------------------------------------------------------------
 -- ** Concrete syntax
 
-instance ToJSON Concrete where
-  toJSON (Concrete cncid absid flags params lincats lins) 
-    = object ["cnc"     .= cncid,
-              "abs"     .= absid,
-              "flags"   .= flags,
-              "params"  .= params,
-              "lincats" .= lincats,
-              "lins"    .= lins]
-
-instance FromJSON Concrete where
-  parseJSON = withObject "Concrete" $ \o -> Concrete
-    <$> o .:  "cnc"
-    <*> o .:  "abs"
-    <*> o .:? "flags" .!= Flags []
-    <*> o .:  "params"
-    <*> o .:  "lincats"
-    <*> o .:  "lins"
-
-
-instance ToJSON ParamDef where
-  toJSON (ParamDef      p pvs) = object ["param" .= p, "values" .= pvs]
-  toJSON (ParamAliasDef p t)   = object ["param" .= p, "alias"  .= t]
-
-instance FromJSON ParamDef where
-  parseJSON = withObject "ParamDef" $ \o ->
-    choose [ ParamDef      <$> o .: "param" <*> o .: "values"
-           , ParamAliasDef <$> o .: "param" <*> o .: "alias"
-           ]
-
-
-instance ToJSON LincatDef where
-  toJSON (LincatDef c lt) = object ["cat" .= c, "lintype" .= lt]
-
-instance FromJSON LincatDef where
-  parseJSON = withObject "LincatDef" $ \v -> LincatDef <$> v .: "cat" <*> v .: "lintype"
+instance JSON Concrete where
+  showJSON (Concrete cncid absid flags params lincats lins) 
+    = makeObj [("cnc", showJSON cncid),
+               ("abs", showJSON absid),
+               ("flags", showJSON flags),
+               ("params", showJSON params),
+               ("lincats", showJSON lincats),
+               ("lins", showJSON lins)]
 
+instance JSON ParamDef where
+  showJSON (ParamDef      p pvs) = makeObj [("param", showJSON p), ("values", showJSON pvs)]
+  showJSON (ParamAliasDef p t)   = makeObj [("param", showJSON p), ("alias", showJSON t)]
 
-instance ToJSON LinDef where
-  toJSON (LinDef f xs lv) = object ["fun" .= f, "args" .= xs, "lin" .= lv]
+instance JSON LincatDef where
+  showJSON (LincatDef c lt) = makeObj [("cat", showJSON c), ("lintype", showJSON lt)]
 
-instance FromJSON LinDef where
-  parseJSON = withObject "LinDef" $ \v -> LinDef <$> v .: "fun" <*> v .: "args" <*> v .: "lin"
+instance JSON LinDef where
+  showJSON (LinDef f xs lv) = makeObj [("fun", showJSON f), ("args", showJSON xs), ("lin", showJSON lv)]
 
-
-instance ToJSON LinType where
-  toJSON lt = case lt of
+instance JSON LinType where
+  showJSON lt = case lt of
     -- the basic types (Str, Float, Int) are encoded as strings:
-    StrType         -> "Str"
-    FloatType       -> "Float"
-    IntType         -> "Int"
+    StrType         -> showJSON "Str"
+    FloatType       -> showJSON "Float"
+    IntType         -> showJSON "Int"
     -- parameters are also encoded as strings:
-    ParamType pt    -> toJSON pt
+    ParamType pt    -> showJSON pt
     -- tables/tuples are encoded as JSON objects:
-    TableType pt lt -> object [".tblarg" .= pt, ".tblval" .= lt]
-    TupleType lts   -> object [".tuple"  .= lts]
+    TableType pt lt -> makeObj [("tblarg", showJSON pt), ("tblval", showJSON lt)]
+    TupleType lts   -> makeObj [("tuple",  showJSON lts)]
     -- records are encoded as records:
-    RecordType rows -> toJSON rows
-
-instance FromJSON LinType where
-  parseJSON (String "Str")   = return StrType
-  parseJSON (String "Float") = return FloatType
-  parseJSON (String "Int")   = return IntType
-  parseJSON (String param)   = return (ParamType (ParamTypeId (ParamId (unpack param))))
-  parseJSON val@(Object o)   = choose [ (TableType  <$> o .: ".tblarg" <*> o .: ".tblval")
-                                      , (TupleType  <$> o .: ".tuple")
-                                      , (RecordType <$> parseJSON val)
-                                      ]
-  parseJSON val = typeMismatch "LinType" val
-
-
-instance ToJSON LinValue where
-  toJSON lv = case lv of
+    RecordType rows -> showJSON rows
+
+instance JSON LinValue where
+  showJSON lv = case lv of
     -- basic values (Str, Float, Int) are encoded as JSON strings/numbers:
-    StrConstant    s  -> toJSON s
-    FloatConstant  f  -> toJSON f
-    IntConstant    n  -> toJSON n
+    StrConstant    s  -> showJSON s
+    FloatConstant  f  -> showJSON f
+    IntConstant    n  -> showJSON n
     -- concatenation is encoded as a JSON array:
-    ConcatValue  v v' -> Array [toJSON v, toJSON v']
+    ConcatValue  v v' -> showJSON [showJSON v, showJSON v']
     -- most values are encoded as JSON objects:
-    ParamConstant  pv -> object [".param"    .= pv]
-    PredefValue    p  -> object [".predef"   .= p]
-    TableValue  t tvs -> object [".tblarg"   .= t, ".tblrows"    .= tvs]
---  VTableValue  t ts -> object [".vtblarg"  .= t, ".vtblrows"   .= ts]
-    TupleValue    lvs -> object [".tuple"    .= lvs]
-    VarValue       v  -> object [".var"      .= v]
-    ErrorValue     s  -> object [".error"    .= s]
-    Projection  lv l  -> object [".project"  .= lv, ".label" .= l]
-    Selection   tv pv -> object [".select"   .= tv, ".key" .= pv]
-    VariantValue   vs -> object [".variants" .= vs]
-    PreValue alts def -> object [".pre"      .= alts, ".default" .= def]
+    ParamConstant  pv -> makeObj [("param",    showJSON pv)]
+    PredefValue    p  -> makeObj [("predef",   showJSON p)]
+    TableValue  t tvs -> makeObj [("tblarg",   showJSON t), ("tblrows", showJSON tvs)]
+    TupleValue    lvs -> makeObj [("tuple",    showJSON lvs)]
+    VarValue       v  -> makeObj [("var",      showJSON v)]
+    ErrorValue     s  -> makeObj [("error",    showJSON s)]
+    Projection  lv l  -> makeObj [("project",  showJSON lv), ("label", showJSON l)]
+    Selection   tv pv -> makeObj [("select",   showJSON tv), ("key", showJSON pv)]
+    VariantValue   vs -> makeObj [("variants", showJSON vs)]
+    PreValue alts def -> makeObj [("pre", showJSON alts), ("default", showJSON def)]
     -- records are encoded directly as JSON records:
-    RecordValue  rows -> toJSON rows
-
-instance FromJSON LinValue where
-  parseJSON (String s)     = return (StrConstant (unpack s))
-  parseJSON (Number n)     = return (either FloatConstant IntConstant (floatingOrInteger n))
-  parseJSON (Array [v,v']) = ConcatValue <$> parseJSON v <*> parseJSON v'
-  parseJSON val@(Object o) = choose [ ParamConstant <$> o .: ".param"
-                                    , PredefValue   <$> o .: ".predef"
-                                    , TableValue    <$> o .: ".tblarg"  <*> o .: ".tblrows"
---                                  , VTableValue   <$> o .: ".vtblarg" <*> o .: ".vtblrows"
-                                    , TupleValue    <$> o .: ".tuple"
-                                    , VarValue      <$> o .: ".var"
-                                    , ErrorValue    <$> o .: ".error"
-                                    , Projection    <$> o .: ".project" <*> o .: ".label"
-                                    , Selection     <$> o .: ".select"  <*> o .: ".key"
-                                    , VariantValue  <$> o .: ".variants"
-                                    , PreValue      <$> o .: ".pre"     <*> o .: ".default"
-                                    , RecordValue   <$> parseJSON val
-                                    ]
-  parseJSON val = typeMismatch "LinValue" val
-
-
-instance ToJSON LinPattern where
-  toJSON linpat = case linpat of
+    RecordValue  rows -> showJSON rows
+
+instance JSON LinPattern where
+  showJSON linpat = case linpat of
     -- wildcards and patterns without arguments are encoded as strings:
-    WildPattern -> "_"
-    ParamPattern (Param p []) -> toJSON p
+    WildPattern -> showJSON "_"
+    ParamPattern (Param p []) -> showJSON p
     -- complex patterns are encoded as JSON objects:
-    ParamPattern pv -> toJSON pv
+    ParamPattern pv -> showJSON pv
     -- and records as records:
-    RecordPattern r -> toJSON r
-
-instance FromJSON LinPattern where
-  parseJSON (String "_") = return WildPattern
-  parseJSON (String  s)  = return (ParamPattern (Param (ParamId (unpack s)) []))
-  parseJSON val = choose [ ParamPattern  <$> parseJSON val
-                         , RecordPattern <$> parseJSON val
-                         , typeMismatch "LinPattern" val
-                         ]
+    RecordPattern r -> showJSON r
 
-
-instance ToJSON arg => ToJSON (Param arg) where
+instance JSON arg => JSON (Param arg) where
   -- parameters without arguments are encoded as strings:
-  toJSON (Param p [])   = toJSON p
-  toJSON (Param p args) = object [".paramid" .= p, ".args" .= args]
-
-instance FromJSON arg => FromJSON (Param arg) where
-  parseJSON (String p) = return (Param (ParamId (unpack p)) [])
-  parseJSON (Object o) = Param <$> o .: ".paramid" <*> o .: ".args"
-  parseJSON val = typeMismatch "Param" val
-
+  showJSON (Param p [])   = showJSON p
+  showJSON (Param p args) = makeObj [("paramid", showJSON p), ("args", showJSON args)]
 
-instance ToJSON a => ToJSON (RecordRow a) where
+instance JSON a => JSON (RecordRow a) where
   -- record rows and lists of record rows are both encoded as JSON records (i.e., objects)
-  toJSON row = object [toJSONRecordRow row]
-  toJSONList = object . map toJSONRecordRow
+  showJSON row = makeObj [toJSONRecordRow row]
 
-toJSONRecordRow :: ToJSON a => RecordRow a -> Pair
-toJSONRecordRow (RecordRow (LabelId lbl) val) = pack lbl .= val
+toJSONRecordRow :: JSON a => RecordRow a -> (String,JSValue)
+toJSONRecordRow (RecordRow (LabelId lbl) val) = (lbl, showJSON val)
 
-instance FromJSON a => FromJSON (RecordRow a) where
-  parseJSON     = withObject  "RecordRow"  $ \o -> parseJSONRecordRow (head (HM.toList o))
-  parseJSONList = withObject "[RecordRow]" $ \o -> CM.mapM parseJSONRecordRow (HM.toList o) 
-
-parseJSONRecordRow :: FromJSON a => (Text, Value) -> Parser (RecordRow a)
-parseJSONRecordRow (lbl, val) = do val' <- parseJSON val
-                                   return (RecordRow (LabelId (unpack lbl)) val')
-
-
-instance ToJSON TableRowValue where
-  toJSON (TableRowValue l v) = object [".pattern" .= l, ".value" .= v]
-
-instance FromJSON TableRowValue where
-  parseJSON = withObject "TableRowValue" $ \v -> TableRowValue <$> v .: ".pattern" <*> v .: ".value"
+instance JSON TableRowValue where
+  showJSON (TableRowValue l v) = makeObj [("pattern", showJSON l), ("value", showJSON l)]
 
 
 -- *** Identifiers in Concrete Syntax
 
-instance ToJSON PredefId   where toJSON (PredefId    s) = toJSON s
-instance ToJSON LabelId    where toJSON (LabelId     s) = toJSON s
-instance ToJSON VarValueId where toJSON (VarValueId  s) = toJSON s
-instance ToJSON ParamId    where toJSON (ParamId     s) = toJSON s
-instance ToJSON ParamType  where toJSON (ParamTypeId s) = toJSON s
-
-instance FromJSON PredefId   where parseJSON = coerceFrom "PredefId"   PredefId
-instance FromJSON LabelId    where parseJSON = coerceFrom "LabelId"    LabelId
-instance FromJSON VarValueId where parseJSON = coerceFrom "VarValueId" VarValueId
-instance FromJSON ParamId    where parseJSON = coerceFrom "ParamId"    ParamId
-instance FromJSON ParamType  where parseJSON = coerceFrom "ParamType"  ParamTypeId
-
+instance JSON PredefId   where showJSON (PredefId    s) = showJSON s
+instance JSON LabelId    where showJSON (LabelId     s) = showJSON s
+instance JSON VarValueId where showJSON (VarValueId  s) = showJSON s
+instance JSON ParamId    where showJSON (ParamId     s) = showJSON s
+instance JSON ParamType  where showJSON (ParamTypeId s) = showJSON s
 
 --------------------------------------------------------------------------------
 -- ** Used in both Abstract and Concrete Syntax
 
-instance ToJSON ModId where toJSON (ModId s) = toJSON s
-instance ToJSON CatId where toJSON (CatId s) = toJSON s
-instance ToJSON FunId where toJSON (FunId s) = toJSON s
+instance JSON ModId where showJSON (ModId s) = showJSON s
+instance JSON CatId where showJSON (CatId s) = showJSON s
+instance JSON FunId where showJSON (FunId s) = showJSON s
 
-instance FromJSON ModId where parseJSON = coerceFrom "ModId" ModId
-instance FromJSON CatId where parseJSON = coerceFrom "CatId" CatId
-instance FromJSON FunId where parseJSON = coerceFrom "FunId" FunId
-
-
-instance ToJSON VarId where
+instance JSON VarId where
   -- the anonymous variable is the underscore:
-  toJSON Anonymous = "_"
-  toJSON (VarId x) = toJSON x
-
-instance FromJSON VarId where
-  parseJSON (String "_") = return Anonymous
-  parseJSON (String  s)  = return (VarId (unpack s))
-  parseJSON val = typeMismatch "VarId" val
+  showJSON Anonymous = showJSON "_"
+  showJSON (VarId x) = showJSON x
 
-
-instance ToJSON Flags where
+instance JSON Flags where
   -- flags are encoded directly as JSON records (i.e., objects):
-  toJSON (Flags fs) = object [ pack f .= v | (f, v) <- fs ]
-
-instance FromJSON Flags where
-  parseJSON = withObject "Flags" $ \o -> Flags <$> CM.mapM parseJSONFlag (HM.toList o)
-    where parseJSONFlag (flag, val) = do val' <- parseJSON val
-                                         return (unpack flag, val')
-
+  showJSON (Flags fs) = makeObj [(f,showJSON v) | (f, v) <- fs]
 
-instance ToJSON FlagValue where
+instance JSON FlagValue where
   -- flag values are encoded as basic JSON types:
-  toJSON (Str s) = toJSON s
-  toJSON (Int i) = toJSON i
-  toJSON (Flt f) = toJSON f
-
-instance FromJSON FlagValue where
-  parseJSON (String s) = return $ Str (unpack s)
-  parseJSON (Number n) = return $ case floatingOrInteger n of
-                                    Left  f -> Flt f
-                                    Right i -> Int i
-  parseJSON invalid = typeMismatch "FlagValue" invalid
-
-
---------------------------------------------------------------------------------
--- ** Helper functions
-
-choose :: [Parser a] -> Parser a
-choose = CM.msum
-
-coerceFrom :: FromJSON s => String -> (s -> a) -> Value -> Parser a
-coerceFrom expected constructor obj = modifyFailure failure $ fmap constructor $ parseJSON obj
-  where failure f = "(while parsing " ++ expected ++ ") " ++ f
+  showJSON (Str s) = showJSON s
+  showJSON (Int i) = showJSON i
+  showJSON (Flt f) = showJSON f
 
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index 276b41c8a..b99e2dbe9 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -89,7 +89,6 @@ data Phase = Preproc | Convert | Compile | Link
 data OutputFormat = FmtPGFPretty
                   | FmtCanonicalGF
                   | FmtCanonicalJson
-                  | FmtCanonicalYaml
                   | FmtJavaScript 
                   | FmtPython 
                   | FmtHaskell 
@@ -474,7 +473,6 @@ outputFormatsExpl =
     [(("pgf_pretty",   FmtPGFPretty),"human-readable pgf"),
      (("canonical_gf", FmtCanonicalGF),"Canonical GF source files"),
      (("canonical_json", FmtCanonicalJson),"Canonical JSON source files"),
-     (("canonical_yaml", FmtCanonicalYaml),"Canonical YAML source files"),
      (("js",           FmtJavaScript),"JavaScript (whole grammar)"),
      (("python",       FmtPython),"Python (whole grammar)"),
      (("haskell",      FmtHaskell),"Haskell (abstract syntax)"),