From 22ba8d34ff00bde6aa83dc9bdcdd13de34799c08 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Tue, 23 Jun 2015 12:58:14 +0000
Subject: Bump version of .gfo and .pgf files, improve error messages on
 version mismatch

Becacuse of the new special tokens added to the Symbol type, .gfo and .pgf
files produced with the current version of GF can not always be used with
older versions of GF and the PGF run-time system.

The PGF version number was increased from (2,0) to (2,1). GF can still
read version (2,0) and (1,0), so old PGF files continue to work.

The GFO version was increased from "GF03" to "GF04".
---
 src/compiler/GF/Grammar/Binary.hs | 35 ++++++++++++++---------------------
 1 file changed, 14 insertions(+), 21 deletions(-)

(limited to 'src/compiler/GF/Grammar')

diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs
index 5aed63363..725ae9284 100644
--- a/src/compiler/GF/Grammar/Binary.hs
+++ b/src/compiler/GF/Grammar/Binary.hs
@@ -7,15 +7,13 @@
 --
 -----------------------------------------------------------------------------
 
-module GF.Grammar.Binary(decodeModule,decodeModuleHeader,encodeModule) where
+module GF.Grammar.Binary(VersionTagged(..),decodeModuleHeader,decodeModule,encodeModule) where
 
 import Prelude hiding (catch)
 import Control.Exception(catch,ErrorCall(..),throwIO)
 
---import Data.Char
 import PGF.Internal(Binary(..),Word8,putWord8,getWord8,encodeFile,decodeFile)
---import Control.Monad
-import qualified Data.Map as Map
+import qualified Data.Map as Map(empty)
 import qualified Data.ByteString.Char8 as BS
 
 import GF.Data.Operations
@@ -28,7 +26,7 @@ import PGF() -- Binary instances
 import PGF.Internal(Literal(..))
 
 -- Please change this every time when the GFO format is changed
-gfoVersion = "GF03"
+gfoVersion = "GF04"
 
 instance Binary Ident where
   put id = put (ident2utf8 id)
@@ -315,6 +313,10 @@ instance Binary a => Binary (VersionTagged a) where
              then fmap Tagged get
              else return WrongVersion
 
+instance Functor VersionTagged where
+  fmap f (Tagged a) = Tagged (f a)
+  fmap f WrongVersion = WrongVersion
+
 gfoBinVersion = (b1,b2,b3,b4)
   where [b1,b2,b3,b4] = map (toEnum.fromEnum) gfoVersion :: [Word8]
 
@@ -324,23 +326,14 @@ decodeModule fpath = liftIO $ check =<< decodeFile' fpath
   where
     check (Tagged m) = return m
     check _ = fail ".gfo file version mismatch"
-{-
-decodeModuleHeader fpath = decodeFile_ fpath getVersionedMod
-  where
-    getVersionedMod = do
-      ver <- getGFOVersion
-      if ver == gfoVersion
-        then do (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) <- get
-                return (Just (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty))
-        else return Nothing
---}
---{-
-decodeModuleHeader fpath = fmap check $ decodeFile' fpath
+
+-- | Read just the module header, the returned 'Module' will have an empty body
+decodeModuleHeader :: MonadIO io => FilePath -> io (VersionTagged Module)
+decodeModuleHeader = liftIO . fmap (fmap conv) . decodeFile'
   where
-    check (Tagged (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc)) =
-        (Just (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty))
-    check _ = Nothing
---}
+    conv (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) =
+        (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty)
+
 encodeModule :: MonadIO io => FilePath -> SourceModule -> io ()
 encodeModule fpath mo = liftIO $ encodeFile fpath (Tagged mo)
 
-- 
cgit v1.2.3