Switch to using binary instead of cereal.

This commit is contained in:
Daniel Gröber 2015-11-18 20:51:37 +01:00
parent 54801d950a
commit b923e2662d
5 changed files with 32 additions and 24 deletions

View File

@ -31,7 +31,8 @@ import Control.Monad
import Control.Category ((.))
import Data.Maybe
import Data.Monoid
import Data.Serialize (Serialize)
import Data.Version
import Data.Binary (Binary)
import Data.Traversable
import Distribution.Helper hiding (Programs(..))
import qualified Distribution.Helper as CH
@ -289,7 +290,7 @@ helperProgs progs = CH.Programs {
ghcPkgProgram = T.ghcPkgProgram progs
}
chCached :: (Applicative m, IOish m, Gm m, Serialize a)
chCached :: (Applicative m, IOish m, Gm m, Binary a)
=> (FilePath -> Cached m GhcModState ChCacheData a) -> m a
chCached c = do
projdir <- cradleRootDir <$> cradle
@ -305,7 +306,7 @@ chCached c = do
progs' <- patchStackPrograms crdl (optPrograms opts)
return $ ( helperProgs progs'
, projdir
, (gmVer, chVer)
, (showVersion gmVer, chVer)
)
gmVer = GhcMod.version

View File

@ -8,11 +8,11 @@ import Control.Arrow (first)
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.Maybe
import Data.Serialize (Serialize, encode, decode)
import Data.Binary (Binary, encode, decodeOrFail)
import Data.Version
import Data.Label
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS8
import System.FilePath
import Utils (TimedFile(..), timeMaybe, mightExist)
import Paths_ghc_mod (version)
@ -22,7 +22,7 @@ import Language.Haskell.GhcMod.Caching.Types
import Language.Haskell.GhcMod.Logging
-- | Cache a MonadIO action with proper invalidation.
cached :: forall m a d. (Gm m, MonadIO m, Serialize a, Eq d, Serialize d, Show d)
cached :: forall m a d. (Gm m, MonadIO m, Binary a, Eq d, Binary d, Show d)
=> FilePath -- ^ Directory to prepend to 'cacheFile'
-> Cached m GhcModState d a -- ^ Cache descriptor
-> d
@ -84,9 +84,13 @@ cached dir cd d = do
case first BS8.words $ BS8.span (/='\n') cc of
(["Written", "by", "ghc-mod", ver], rest)
| BS8.unpack ver == showVersion version ->
return $ either (const Nothing) Just $ decode $ BS.drop 1 rest
return $ either (const Nothing) Just $ decodeE $ BS.drop 1 rest
_ -> return Nothing
decodeE b = do
case decodeOrFail b of
Left (_rest, _offset, errmsg) -> Left errmsg
Right (_reset, _offset, a) -> Right a
timeCacheInput :: MonadIO m => FilePath -> FilePath -> [FilePath] -> m TimedCacheFiles
timeCacheInput dir cfile ifs = liftIO $ do
-- TODO: is checking the times this way around race free?

View File

@ -2,7 +2,6 @@ module Language.Haskell.GhcMod.Caching.Types where
import Utils
import Data.Label
import Data.Version
import Distribution.Helper
type CacheContents d a = Maybe ([FilePath], d, a)
@ -49,4 +48,4 @@ data TimedCacheFiles = TimedCacheFiles {
-- ^ Timestamped files returned by the cached action
} deriving (Eq, Ord, Show)
type ChCacheData = (Programs, FilePath, (Version, [Char]))
type ChCacheData = (Programs, FilePath, (String, String))

View File

@ -15,8 +15,7 @@ import Control.Exception (Exception)
import Control.Applicative
import Control.Concurrent
import Control.Monad
import Data.Serialize
import Data.Version
import Data.Binary
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
@ -25,6 +24,8 @@ import Data.Monoid
import Data.Maybe
import Data.Typeable (Typeable)
import Data.IORef
import Data.Time (UTCTime(..))
import Data.Time.Calendar (Day(..))
import Data.Label.Derive
import Distribution.Helper hiding (Programs(..))
import qualified Distribution.Helper as CabalHelper
@ -231,7 +232,7 @@ data GhcPkgDb = GlobalDb
| PackageDb String
deriving (Eq, Show, Generic)
instance Serialize GhcPkgDb
instance Binary GhcPkgDb
-- | A single GHC command line option.
type GHCOption = String
@ -262,7 +263,7 @@ data GmModuleGraph = GmModuleGraph {
gmgGraph :: Map ModulePath (Set ModulePath)
} deriving (Eq, Ord, Show, Read, Generic, Typeable)
instance Serialize GmModuleGraph where
instance Binary GmModuleGraph where
put GmModuleGraph {..} = put (mpim, graph)
where
mpim :: Map ModulePath Integer
@ -302,13 +303,13 @@ data GmComponent (t :: GmComponentType) eps = GmComponent {
, gmcSourceDirs :: [FilePath]
} deriving (Eq, Ord, Show, Read, Generic, Functor)
instance Serialize eps => Serialize (GmComponent t eps)
instance Binary eps => Binary (GmComponent t eps)
data ModulePath = ModulePath { mpModule :: ModuleName, mpPath :: FilePath }
deriving (Eq, Ord, Show, Read, Generic, Typeable)
instance Serialize ModulePath
instance Binary ModulePath
instance Serialize ModuleName where
instance Binary ModuleName where
get = mkModuleName <$> get
put mn = put (moduleNameString mn)
@ -366,13 +367,16 @@ instance Error GhcModError where
instance Exception GhcModError
deriving instance Generic Version
instance Serialize Version
instance Binary CabalHelper.Programs
instance Binary ChModuleName
instance Binary ChComponentName
instance Binary ChEntrypoint
instance Serialize CabalHelper.Programs
instance Serialize ChModuleName
instance Serialize ChComponentName
instance Serialize ChEntrypoint
instance Binary UTCTime where
put (UTCTime (ModifiedJulianDay day) difftime) =
put day >> put (toRational difftime)
get = do
UTCTime <$> (ModifiedJulianDay <$> get) <*> (fromRational <$> get)
mkLabel ''GhcModCaches
mkLabel ''GhcModState

View File

@ -147,7 +147,7 @@ Library
Utils
Build-Depends: base < 5 && >= 4.0
, bytestring < 0.11
, cereal < 0.5 && >= 0.4
, binary < 0.8 && >= 0.7
, containers < 0.6
, cabal-helper < 0.7 && >= 0.6.1.0
, deepseq < 1.5