{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.Liquid.GHC.Plugin.Util (
      -- * Serialising and deserialising things from/to specs.
        serialiseLiquidLib
      , deserialiseLiquidLib
      , deserialiseLiquidLibFromEPS

      -- * Aborting the plugin execution
      , pluginAbort
      ) where

import           Data.Foldable                            ( asum )

import           Control.Monad.IO.Class
import           Control.Monad

import qualified Data.Binary                             as B
import           Data.Binary                              ( Binary )
import qualified Data.ByteString.Lazy                    as B
import           Data.Typeable
import           Data.Maybe                               ( listToMaybe )

import           Liquid.GHC.API
import           Language.Haskell.Liquid.GHC.Plugin.Types (LiquidLib)


pluginAbort :: MonadIO m => String -> m a
pluginAbort :: forall (m :: * -> *) a. MonadIO m => String -> m a
pluginAbort = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GhcException -> IO a
throwGhcExceptionIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GhcException
ProgramError

--
-- Serialising and deserialising Specs
--

deserialiseBinaryObjectFromEPS
  :: forall a. (Typeable a, Binary a)
  => Module
  -> ExternalPackageState
  -> Maybe a
deserialiseBinaryObjectFromEPS :: forall a.
(Typeable a, Binary a) =>
Module -> ExternalPackageState -> Maybe a
deserialiseBinaryObjectFromEPS Module
thisModule ExternalPackageState
eps = Maybe a
extractFromEps
  where
    extractFromEps :: Maybe a
    extractFromEps :: Maybe a
extractFromEps = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a.
Typeable a =>
([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a]
findAnns (forall a. Binary a => ByteString -> a
B.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack) (ExternalPackageState -> AnnEnv
eps_ann_env ExternalPackageState
eps) (forall name. Module -> AnnTarget name
ModuleTarget Module
thisModule)

deserialiseBinaryObject :: forall a. (Typeable a, Binary a)
                        => Module
                        -> ExternalPackageState
                        -> HomePackageTable
                        -> Maybe a
deserialiseBinaryObject :: forall a.
(Typeable a, Binary a) =>
Module -> ExternalPackageState -> HomePackageTable -> Maybe a
deserialiseBinaryObject Module
thisModule ExternalPackageState
eps HomePackageTable
hpt =
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe a
extractFromHpt, forall a.
(Typeable a, Binary a) =>
Module -> ExternalPackageState -> Maybe a
deserialiseBinaryObjectFromEPS Module
thisModule ExternalPackageState
eps]
  where
    extractFromHpt :: Maybe a
    extractFromHpt :: Maybe a
extractFromHpt = do
      HomeModInfo
modInfo <- HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt HomePackageTable
hpt (forall unit. GenModule unit -> ModuleName
moduleName Module
thisModule)
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Module
thisModule forall a. Eq a => a -> a -> Bool
== (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface forall a b. (a -> b) -> a -> b
$ HomeModInfo
modInfo))
      [a]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
fromSerialized [Word8] -> a
deserialise forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceAnnotation -> Serialized
ifAnnotatedValue) (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface forall a b. (a -> b) -> a -> b
$ HomeModInfo
modInfo)
      forall a. [a] -> Maybe a
listToMaybe [a]
xs

    deserialise :: [B.Word8] -> a
    deserialise :: [Word8] -> a
deserialise [Word8]
payload = forall a. Binary a => ByteString -> a
B.decode ([Word8] -> ByteString
B.pack [Word8]
payload)

serialiseBinaryObject :: forall a. (Binary a, Typeable a) => a -> Module -> Annotation
serialiseBinaryObject :: forall a. (Binary a, Typeable a) => a -> Module -> Annotation
serialiseBinaryObject a
obj Module
thisModule = Annotation
serialised
  where
    serialised :: Annotation
    serialised :: Annotation
serialised = CoreAnnTarget -> Serialized -> Annotation
Annotation (forall name. Module -> AnnTarget name
ModuleTarget Module
thisModule) (forall a. Typeable a => (a -> [Word8]) -> a -> Serialized
toSerialized (ByteString -> [Word8]
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> ByteString
B.encode) a
obj)

-- | Serialise a 'LiquidLib', removing the termination checks from the target.
serialiseLiquidLib :: LiquidLib -> Module -> Annotation
serialiseLiquidLib :: LiquidLib -> Module -> Annotation
serialiseLiquidLib LiquidLib
lib = forall a. (Binary a, Typeable a) => a -> Module -> Annotation
serialiseBinaryObject @LiquidLib LiquidLib
lib

deserialiseLiquidLib :: Module -> ExternalPackageState -> HomePackageTable -> Maybe LiquidLib
deserialiseLiquidLib :: Module
-> ExternalPackageState -> HomePackageTable -> Maybe LiquidLib
deserialiseLiquidLib Module
thisModule = forall a.
(Typeable a, Binary a) =>
Module -> ExternalPackageState -> HomePackageTable -> Maybe a
deserialiseBinaryObject @LiquidLib Module
thisModule

deserialiseLiquidLibFromEPS :: Module -> ExternalPackageState -> Maybe LiquidLib
deserialiseLiquidLibFromEPS :: Module -> ExternalPackageState -> Maybe LiquidLib
deserialiseLiquidLibFromEPS = forall a.
(Typeable a, Binary a) =>
Module -> ExternalPackageState -> Maybe a
deserialiseBinaryObjectFromEPS @LiquidLib