module IDE.Core.Serializable (
) where
import Distribution.Text (simpleParse,display)
import Control.Monad (liftM)
import Data.Maybe (fromJust)
import Data.Binary.Shared (BinaryShared(..))
import Data.Typeable (Typeable(..))
import Distribution.Package (PackageName(..),PackageIdentifier(..))
import Data.Version (Version(..))
import Distribution.ModuleName (ModuleName)
import MyMissing (forceJust)
import IDE.Core.CTypes
deriving instance Typeable PackageIdentifier
deriving instance Typeable ModuleName
deriving instance Typeable PackageName
instance BinaryShared PackModule where
put = putShared (\ (PM pack' modu') -> do
(put pack')
(put modu'))
get = getShared (do
pack' <- get
modu' <- get
return (PM pack' modu'))
instance BinaryShared PackageIdentifier where
put = putShared (\ (PackageIdentifier name' version') -> do
put name'
put version')
get = getShared (do
name' <- get
version' <- get
return (PackageIdentifier name' version'))
instance BinaryShared Version where
put = putShared (\ (Version branch' tags') -> do
put branch'
put tags')
get = getShared (do
branch' <- get
tags' <- get
return (Version branch' tags'))
instance BinaryShared PackageDescr where
put = putShared (\ (PackageDescr packagePD' exposedModulesPD' buildDependsPD'
mbSourcePathPD') -> do
put packagePD'
put exposedModulesPD'
put buildDependsPD'
put mbSourcePathPD')
get = getShared (do
packagePD' <- get
exposedModulesPD' <- get
buildDependsPD' <- get
mbSourcePathPD' <- get
return (PackageDescr packagePD' exposedModulesPD' buildDependsPD'
mbSourcePathPD'))
instance BinaryShared ModuleDescr where
put = putShared (\ (ModuleDescr moduleIdMD' mbSourcePathMD' usagesMD'
idDescriptionsMD') -> do
put moduleIdMD'
put mbSourcePathMD'
put usagesMD'
put idDescriptionsMD')
get = getShared (do
moduleIdMD' <- get
mbSourcePathMD' <- get
usagesMD' <- get
idDescriptionsMD' <- get
return (ModuleDescr moduleIdMD' mbSourcePathMD'
usagesMD' idDescriptionsMD'))
instance BinaryShared Descr where
put (Real (RealDescr descrName2 typeInfo2 descrModu2 mbLocation2 mbComment2 details2 isExp))
= do put (1:: Int)
put descrName2
put typeInfo2
put descrModu2
put mbLocation2
put mbComment2
put details2
put isExp
put (Reexported (ReexportedDescr reexpModu' impDescr'))
= do put (2:: Int)
put reexpModu'
put impDescr'
get = do (typeHint :: Int) <- get
case typeHint of
1 -> do
descrName2 <- get
typeInfo2 <- get
descrModu2 <- get
mbLocation2 <- get
mbComment2 <- get
details2 <- get
isExp2 <- get
return (Real (RealDescr descrName2 typeInfo2 descrModu2 mbLocation2
mbComment2 details2 isExp2))
2 -> do
reexpModu' <- get
impDescr' <- get
return (Reexported (ReexportedDescr reexpModu' impDescr'))
_ -> error "Impossible in Binary Descr get"
instance BinaryShared TypeDescr where
put VariableDescr
= do put (1:: Int)
put (FieldDescr typeDescrF')
= do put (2:: Int)
put typeDescrF'
put (ConstructorDescr typeDescrC')
= do put (3:: Int)
put typeDescrC'
put (DataDescr constructors' fields')
= do put (4:: Int)
put constructors'
put fields'
put TypeDescr
= do put (5:: Int)
put (NewtypeDescr constructor' mbField')
= do put (6:: Int)
put constructor'
put mbField'
put (ClassDescr super' methods')
= do put (7:: Int)
put super'
put methods'
put (MethodDescr classDescrM')
= do put (8:: Int)
put classDescrM'
put (InstanceDescr binds')
= do put (9:: Int)
put binds'
put KeywordDescr
= do put (10:: Int)
put ExtensionDescr
= do put (11:: Int)
put ModNameDescr
= do put (12:: Int)
put QualModNameDescr
= do put (13:: Int)
put ErrorDescr
= do put (14:: Int)
get = do (typeHint :: Int) <- get
case typeHint of
1 -> return VariableDescr
2 -> do
typeDescrF' <- get
return (FieldDescr typeDescrF')
3 -> do
typeDescrC' <- get
return (ConstructorDescr typeDescrC')
4 -> do
constructors' <- get
fields' <- get
return (DataDescr constructors' fields')
5 -> return TypeDescr
6 -> do
constructor' <- get
mbField' <- get
return (NewtypeDescr constructor' mbField')
7 -> do
super' <- get
methods' <- get
return (ClassDescr super' methods')
8 -> do
classDescrM' <- get
return (MethodDescr classDescrM')
9 -> do
binds' <- get
return (InstanceDescr binds')
10 -> return KeywordDescr
11 -> return ExtensionDescr
12 -> return ModNameDescr
13 -> return QualModNameDescr
14 -> return ErrorDescr
_ -> error "Impossible in Binary SpDescr get"
instance BinaryShared SimpleDescr where
put (SimpleDescr sdName' sdType' sdLocation' sdComment' sdExported')
= do put sdName'
put sdType'
put sdLocation'
put sdComment'
put sdExported'
get = do sdName' <- get
sdType' <- get
sdLocation' <- get
sdComment' <- get
sdExported' <- get
return (SimpleDescr sdName' sdType' sdLocation' sdComment' sdExported')
instance BinaryShared Location where
put (Location locationSLine' locationSCol' locationELine' locationECol')
= do put locationSLine'
put locationSCol'
put locationELine'
put locationECol'
get = do locationSLine' <- get
locationSCol' <- get
locationELine' <- get
locationECol' <- get
return (Location locationSLine' locationSCol' locationELine' locationECol')
instance BinaryShared ModuleName where
put = put . display
get = liftM (flip forceJust "BinaryShared>>get(ModuleName)" . simpleParse) get
instance BinaryShared PackageName where
put (PackageName pn) = put pn
get = liftM PackageName get