module GhcDump.Util
    ( -- * Convenient IO
      readDump, readDump'
      -- * Manipulating 'Type's
    , splitFunTys
    , splitForAlls
      -- * Manipulating expressions
    , collectArgs
    , collectBinders
    , collectTyBinders
    ) where

import Prelude hiding (readFile)

import qualified Data.ByteString.Lazy as BSL
import qualified Codec.Serialise as Ser

import GhcDump.Ast
import GhcDump.Reconstruct

readDump' :: FilePath -> IO SModule
readDump' :: FilePath -> IO SModule
readDump' FilePath
fname = ByteString -> SModule
forall a. Serialise a => ByteString -> a
Ser.deserialise (ByteString -> SModule) -> IO ByteString -> IO SModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BSL.readFile FilePath
fname

readDump :: FilePath -> IO Module
readDump :: FilePath -> IO Module
readDump FilePath
fname = SModule -> Module
reconModule (SModule -> Module) -> IO SModule -> IO Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO SModule
readDump' FilePath
fname

splitFunTys :: Type' bndr var -> [Type' bndr var]
splitFunTys :: Type' bndr var -> [Type' bndr var]
splitFunTys = [Type' bndr var] -> Type' bndr var -> [Type' bndr var]
forall bndr var.
[Type' bndr var] -> Type' bndr var -> [Type' bndr var]
go []
  where
    go :: [Type' bndr var] -> Type' bndr var -> [Type' bndr var]
go [Type' bndr var]
acc (FunTy Type' bndr var
a Type' bndr var
b) = [Type' bndr var] -> Type' bndr var -> [Type' bndr var]
go (Type' bndr var
a Type' bndr var -> [Type' bndr var] -> [Type' bndr var]
forall a. a -> [a] -> [a]
: [Type' bndr var]
acc) Type' bndr var
b
    go [Type' bndr var]
acc Type' bndr var
t = [Type' bndr var] -> [Type' bndr var]
forall a. [a] -> [a]
reverse (Type' bndr var
t Type' bndr var -> [Type' bndr var] -> [Type' bndr var]
forall a. a -> [a] -> [a]
: [Type' bndr var]
acc)

splitForAlls :: Type' bndr var -> ([bndr], Type' bndr var)
splitForAlls :: Type' bndr var -> ([bndr], Type' bndr var)
splitForAlls = [bndr] -> Type' bndr var -> ([bndr], Type' bndr var)
forall a var. [a] -> Type' a var -> ([a], Type' a var)
go []
  where
    go :: [a] -> Type' a var -> ([a], Type' a var)
go [a]
acc (ForAllTy a
b Type' a var
t) = [a] -> Type' a var -> ([a], Type' a var)
go (a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc) Type' a var
t
    go [a]
acc Type' a var
t              = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc, Type' a var
t)

collectBinders :: Expr' bndr var -> ([bndr], Expr' bndr var)
collectBinders :: Expr' bndr var -> ([bndr], Expr' bndr var)
collectBinders = [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
forall bndr var.
[bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
go []
  where
    go :: [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
    go :: [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
go [bndr]
acc (ELam bndr
v Expr' bndr var
x) = [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
forall bndr var.
[bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
go (bndr
v bndr -> [bndr] -> [bndr]
forall a. a -> [a] -> [a]
: [bndr]
acc) Expr' bndr var
x
    go [bndr]
acc Expr' bndr var
x          = ([bndr] -> [bndr]
forall a. [a] -> [a]
reverse [bndr]
acc, Expr' bndr var
x)

collectTyBinders :: Expr' bndr var -> ([bndr], Expr' bndr var)
collectTyBinders :: Expr' bndr var -> ([bndr], Expr' bndr var)
collectTyBinders = [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
forall bndr var.
[bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
go []
  where
    go :: [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
    go :: [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
go [bndr]
acc (ETyLam bndr
v Expr' bndr var
x) = [bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
forall bndr var.
[bndr] -> Expr' bndr var -> ([bndr], Expr' bndr var)
go (bndr
v bndr -> [bndr] -> [bndr]
forall a. a -> [a] -> [a]
: [bndr]
acc) Expr' bndr var
x
    go [bndr]
acc Expr' bndr var
x            = ([bndr] -> [bndr]
forall a. [a] -> [a]
reverse [bndr]
acc, Expr' bndr var
x)

collectArgs :: Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
collectArgs :: Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
collectArgs = [Expr' bndr var]
-> Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
forall bndr var.
[Expr' bndr var]
-> Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
go []
  where
    go :: [Expr' bndr var] -> Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
    go :: [Expr' bndr var]
-> Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
go [Expr' bndr var]
acc (EApp Expr' bndr var
x Expr' bndr var
y) = [Expr' bndr var]
-> Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
forall bndr var.
[Expr' bndr var]
-> Expr' bndr var -> (Expr' bndr var, [Expr' bndr var])
go (Expr' bndr var
y Expr' bndr var -> [Expr' bndr var] -> [Expr' bndr var]
forall a. a -> [a] -> [a]
: [Expr' bndr var]
acc) Expr' bndr var
x
    go [Expr' bndr var]
acc Expr' bndr var
x          = (Expr' bndr var
x, [Expr' bndr var]
acc)