{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Language.Haskell.Liquid.GHC.Plugin.Types
    ( SpecComment(..)

    -- * Dealing with specs and their dependencies
    , LiquidLib
    , mkLiquidLib
    , mkSpecComment
    , libTarget
    , libDeps
    , allDeps
    , addLibDependencies

    -- * Carrying data across stages of the compilation pipeline
    , PipelineData(..)

    -- * Acquiring and manipulating data from the typechecking phase
    ) where

import           Data.Binary                             as B
import           Data.Data                               ( Data )
import           GHC.Generics                      hiding ( moduleName )

import           Language.Haskell.Liquid.Parse (BPspec)
import           Language.Haskell.Liquid.Types.Specs
import           Liquid.GHC.API         as GHC
import           Language.Haskell.Liquid.GHC.Misc (realSrcLocSourcePos)
import           Language.Fixpoint.Types.Spans            ( SourcePos, dummyPos )


data LiquidLib = LiquidLib
  {  LiquidLib -> LiftedSpec
llTarget :: LiftedSpec
  -- ^ The target /LiftedSpec/.
  ,  LiquidLib -> TargetDependencies
llDeps   :: TargetDependencies
  -- ^ The specs which were necessary to produce the target 'BareSpec'.
  } deriving (Int -> LiquidLib -> ShowS
[LiquidLib] -> ShowS
LiquidLib -> String
(Int -> LiquidLib -> ShowS)
-> (LiquidLib -> String)
-> ([LiquidLib] -> ShowS)
-> Show LiquidLib
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiquidLib -> ShowS
showsPrec :: Int -> LiquidLib -> ShowS
$cshow :: LiquidLib -> String
show :: LiquidLib -> String
$cshowList :: [LiquidLib] -> ShowS
showList :: [LiquidLib] -> ShowS
Show, Typeable LiquidLib
Typeable LiquidLib =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> LiquidLib -> c LiquidLib)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LiquidLib)
-> (LiquidLib -> Constr)
-> (LiquidLib -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LiquidLib))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LiquidLib))
-> ((forall b. Data b => b -> b) -> LiquidLib -> LiquidLib)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LiquidLib -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LiquidLib -> r)
-> (forall u. (forall d. Data d => d -> u) -> LiquidLib -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LiquidLib -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib)
-> Data LiquidLib
LiquidLib -> Constr
LiquidLib -> DataType
(forall b. Data b => b -> b) -> LiquidLib -> LiquidLib
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LiquidLib -> u
forall u. (forall d. Data d => d -> u) -> LiquidLib -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidLib -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidLib -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiquidLib
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiquidLib -> c LiquidLib
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiquidLib)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LiquidLib)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiquidLib -> c LiquidLib
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiquidLib -> c LiquidLib
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiquidLib
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiquidLib
$ctoConstr :: LiquidLib -> Constr
toConstr :: LiquidLib -> Constr
$cdataTypeOf :: LiquidLib -> DataType
dataTypeOf :: LiquidLib -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiquidLib)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiquidLib)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LiquidLib)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LiquidLib)
$cgmapT :: (forall b. Data b => b -> b) -> LiquidLib -> LiquidLib
gmapT :: (forall b. Data b => b -> b) -> LiquidLib -> LiquidLib
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidLib -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidLib -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidLib -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidLib -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LiquidLib -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> LiquidLib -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LiquidLib -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LiquidLib -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidLib -> m LiquidLib
Data, (forall x. LiquidLib -> Rep LiquidLib x)
-> (forall x. Rep LiquidLib x -> LiquidLib) -> Generic LiquidLib
forall x. Rep LiquidLib x -> LiquidLib
forall x. LiquidLib -> Rep LiquidLib x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LiquidLib -> Rep LiquidLib x
from :: forall x. LiquidLib -> Rep LiquidLib x
$cto :: forall x. Rep LiquidLib x -> LiquidLib
to :: forall x. Rep LiquidLib x -> LiquidLib
Generic)

instance B.Binary LiquidLib

-- | Creates a new 'LiquidLib' with no dependencies.
mkLiquidLib :: LiftedSpec -> LiquidLib
mkLiquidLib :: LiftedSpec -> LiquidLib
mkLiquidLib LiftedSpec
s = LiftedSpec -> TargetDependencies -> LiquidLib
LiquidLib LiftedSpec
s TargetDependencies
forall a. Monoid a => a
mempty

-- | Adds a set of dependencies to the input 'LiquidLib'.
addLibDependencies :: TargetDependencies -> LiquidLib -> LiquidLib
addLibDependencies :: TargetDependencies -> LiquidLib -> LiquidLib
addLibDependencies TargetDependencies
deps LiquidLib
lib = LiquidLib
lib { llDeps = deps <> llDeps lib }

-- | Returns the target 'LiftedSpec' of this 'LiquidLib'.
libTarget :: LiquidLib -> LiftedSpec
libTarget :: LiquidLib -> LiftedSpec
libTarget = LiquidLib -> LiftedSpec
llTarget

-- | Returns all the dependencies of this 'LiquidLib'.
libDeps :: LiquidLib -> TargetDependencies
libDeps :: LiquidLib -> TargetDependencies
libDeps = LiquidLib -> TargetDependencies
llDeps

-- | Extracts all the dependencies from a collection of 'LiquidLib's.
allDeps :: Foldable f => f LiquidLib -> TargetDependencies
allDeps :: forall (f :: * -> *).
Foldable f =>
f LiquidLib -> TargetDependencies
allDeps = (TargetDependencies -> LiquidLib -> TargetDependencies)
-> TargetDependencies -> f LiquidLib -> TargetDependencies
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\TargetDependencies
acc LiquidLib
lib -> TargetDependencies
acc TargetDependencies -> TargetDependencies -> TargetDependencies
forall a. Semigroup a => a -> a -> a
<> LiquidLib -> TargetDependencies
llDeps LiquidLib
lib) TargetDependencies
forall a. Monoid a => a
mempty

-- | Just a small wrapper around the 'SourcePos' and the text fragment of a LH spec comment.
newtype SpecComment =
    SpecComment (SourcePos, String)
    deriving Int -> SpecComment -> ShowS
[SpecComment] -> ShowS
SpecComment -> String
(Int -> SpecComment -> ShowS)
-> (SpecComment -> String)
-> ([SpecComment] -> ShowS)
-> Show SpecComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecComment -> ShowS
showsPrec :: Int -> SpecComment -> ShowS
$cshow :: SpecComment -> String
show :: SpecComment -> String
$cshowList :: [SpecComment] -> ShowS
showList :: [SpecComment] -> ShowS
Show

mkSpecComment :: (Maybe RealSrcLoc, String) -> SpecComment
mkSpecComment :: (Maybe RealSrcLoc, String) -> SpecComment
mkSpecComment (Maybe RealSrcLoc
m, String
s) = (SourcePos, String) -> SpecComment
SpecComment (Maybe RealSrcLoc -> SourcePos
sourcePos Maybe RealSrcLoc
m, String
s)
  where
    sourcePos :: Maybe RealSrcLoc -> SourcePos
sourcePos Maybe RealSrcLoc
Nothing = String -> SourcePos
dummyPos String
"<no source information>"
    sourcePos (Just RealSrcLoc
sp) = RealSrcLoc -> SourcePos
realSrcLocSourcePos RealSrcLoc
sp

--
-- Passing data between stages of the pipeline
--
-- The plugin architecture doesn't provide a default system to \"thread\" data across stages of the
-- compilation pipeline, which means that plugin implementors have two choices:
--
-- 1. Serialise any data they want to carry around inside annotations, but this can be potentially costly;
-- 2. Pass data inside IORefs.

data PipelineData = PipelineData {
    PipelineData -> ModGuts
pdUnoptimisedCore :: ModGuts
  , PipelineData -> [BPspec]
pdSpecComments :: [BPspec]
  }