    {-# OPTIONS_GHC
        -XScopedTypeVariables
        -XStandaloneDeriving
        -XDeriveDataTypeable
        -fno-warn-orphans #-}

    -----------------------------------------------------------------------------
    --
    -- Module      :  IDE.Core.Serializable
    -- Copyright   :  2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie
    -- License     :  GPL
    --
    -- Maintainer  :  Jutaro <jutaro@leksah.org>
    -- Stability   :  provisional
    -- Portability :
    --
    -- |
    --
    -----------------------------------------------------------------------------

    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