Switch to using binary instead of cereal.
This commit is contained in:
parent
54801d950a
commit
b923e2662d
@ -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
|
||||
|
@ -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?
|
||||
|
@ -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))
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user