{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE LambdaCase                 #-}

module HiFileParser
    ( Interface(..)
    , List(..)
    , Dictionary(..)
    , Module(..)
    , Usage(..)
    , Dependencies(..)
    , getInterface
    , fromFile
    ) where

{- HLINT ignore "Reduce duplication" -}

import           Control.Monad                 (replicateM, replicateM_, when)
import           Data.Binary                   (Word64,Word32,Word8)
import qualified Data.Binary.Get as G          (Get, Decoder (..), bytesRead,
                                                getByteString, getInt64be,
                                                getWord32be, getWord64be,
                                                getWord8, lookAhead,
                                                runGetIncremental, skip)
import           Data.Bool                     (bool)
import           Data.ByteString.Lazy.Internal (defaultChunkSize)
import           Data.Char                     (chr)
import           Data.Functor                  (void, ($>))
import           Data.Maybe                    (catMaybes)
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup                ((<>))
#endif
import qualified Data.Vector                   as V
import           GHC.IO.IOMode                 (IOMode (..))
import           Numeric                       (showHex)
import           RIO.ByteString                as B (ByteString, hGetSome, null)
import           RIO                           (Int64,Generic, NFData)
import           System.IO                     (withBinaryFile)
import           Data.Bits                     (FiniteBits(..),testBit,
                                                unsafeShiftL,(.|.),clearBit,
                                                complement)
import           Control.Monad.State           (StateT, evalStateT, get, gets,
                                                lift, modify)
import qualified Debug.Trace

newtype IfaceGetState = IfaceGetState
  { IfaceGetState -> IsBoot
useLEB128 :: Bool -- ^ Use LEB128 encoding for numbers

  }

data IfaceVersion
  = V7021
  | V7041
  | V7061
  | V7081
  | V8001
  | V8021
  | V8041
  | V8061
  | V8101
  | V9001
  | V9041
  deriving (Int -> IfaceVersion -> ShowS
[IfaceVersion] -> ShowS
IfaceVersion -> String
(Int -> IfaceVersion -> ShowS)
-> (IfaceVersion -> String)
-> ([IfaceVersion] -> ShowS)
-> Show IfaceVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IfaceVersion] -> ShowS
$cshowList :: [IfaceVersion] -> ShowS
show :: IfaceVersion -> String
$cshow :: IfaceVersion -> String
showsPrec :: Int -> IfaceVersion -> ShowS
$cshowsPrec :: Int -> IfaceVersion -> ShowS
Show,IfaceVersion -> IfaceVersion -> IsBoot
(IfaceVersion -> IfaceVersion -> IsBoot)
-> (IfaceVersion -> IfaceVersion -> IsBoot) -> Eq IfaceVersion
forall a. (a -> a -> IsBoot) -> (a -> a -> IsBoot) -> Eq a
/= :: IfaceVersion -> IfaceVersion -> IsBoot
$c/= :: IfaceVersion -> IfaceVersion -> IsBoot
== :: IfaceVersion -> IfaceVersion -> IsBoot
$c== :: IfaceVersion -> IfaceVersion -> IsBoot
Eq,Eq IfaceVersion
Eq IfaceVersion
-> (IfaceVersion -> IfaceVersion -> Ordering)
-> (IfaceVersion -> IfaceVersion -> IsBoot)
-> (IfaceVersion -> IfaceVersion -> IsBoot)
-> (IfaceVersion -> IfaceVersion -> IsBoot)
-> (IfaceVersion -> IfaceVersion -> IsBoot)
-> (IfaceVersion -> IfaceVersion -> IfaceVersion)
-> (IfaceVersion -> IfaceVersion -> IfaceVersion)
-> Ord IfaceVersion
IfaceVersion -> IfaceVersion -> IsBoot
IfaceVersion -> IfaceVersion -> Ordering
IfaceVersion -> IfaceVersion -> IfaceVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoot)
-> (a -> a -> IsBoot)
-> (a -> a -> IsBoot)
-> (a -> a -> IsBoot)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IfaceVersion -> IfaceVersion -> IfaceVersion
$cmin :: IfaceVersion -> IfaceVersion -> IfaceVersion
max :: IfaceVersion -> IfaceVersion -> IfaceVersion
$cmax :: IfaceVersion -> IfaceVersion -> IfaceVersion
>= :: IfaceVersion -> IfaceVersion -> IsBoot
$c>= :: IfaceVersion -> IfaceVersion -> IsBoot
> :: IfaceVersion -> IfaceVersion -> IsBoot
$c> :: IfaceVersion -> IfaceVersion -> IsBoot
<= :: IfaceVersion -> IfaceVersion -> IsBoot
$c<= :: IfaceVersion -> IfaceVersion -> IsBoot
< :: IfaceVersion -> IfaceVersion -> IsBoot
$c< :: IfaceVersion -> IfaceVersion -> IsBoot
compare :: IfaceVersion -> IfaceVersion -> Ordering
$ccompare :: IfaceVersion -> IfaceVersion -> Ordering
Ord,Int -> IfaceVersion
IfaceVersion -> Int
IfaceVersion -> [IfaceVersion]
IfaceVersion -> IfaceVersion
IfaceVersion -> IfaceVersion -> [IfaceVersion]
IfaceVersion -> IfaceVersion -> IfaceVersion -> [IfaceVersion]
(IfaceVersion -> IfaceVersion)
-> (IfaceVersion -> IfaceVersion)
-> (Int -> IfaceVersion)
-> (IfaceVersion -> Int)
-> (IfaceVersion -> [IfaceVersion])
-> (IfaceVersion -> IfaceVersion -> [IfaceVersion])
-> (IfaceVersion -> IfaceVersion -> [IfaceVersion])
-> (IfaceVersion -> IfaceVersion -> IfaceVersion -> [IfaceVersion])
-> Enum IfaceVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IfaceVersion -> IfaceVersion -> IfaceVersion -> [IfaceVersion]
$cenumFromThenTo :: IfaceVersion -> IfaceVersion -> IfaceVersion -> [IfaceVersion]
enumFromTo :: IfaceVersion -> IfaceVersion -> [IfaceVersion]
$cenumFromTo :: IfaceVersion -> IfaceVersion -> [IfaceVersion]
enumFromThen :: IfaceVersion -> IfaceVersion -> [IfaceVersion]
$cenumFromThen :: IfaceVersion -> IfaceVersion -> [IfaceVersion]
enumFrom :: IfaceVersion -> [IfaceVersion]
$cenumFrom :: IfaceVersion -> [IfaceVersion]
fromEnum :: IfaceVersion -> Int
$cfromEnum :: IfaceVersion -> Int
toEnum :: Int -> IfaceVersion
$ctoEnum :: Int -> IfaceVersion
pred :: IfaceVersion -> IfaceVersion
$cpred :: IfaceVersion -> IfaceVersion
succ :: IfaceVersion -> IfaceVersion
$csucc :: IfaceVersion -> IfaceVersion
Enum)
  -- careful, the Ord matters!



type Get a = StateT IfaceGetState G.Get a

enableDebug :: Bool
enableDebug :: IsBoot
enableDebug = IsBoot
False

traceGet :: String -> Get ()
traceGet :: String -> Get ()
traceGet String
s
  | IsBoot
enableDebug = String -> Get () -> Get ()
forall a. String -> a -> a
Debug.Trace.trace String
s (() -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  | IsBoot
otherwise   = () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

traceShow :: Show a => String -> Get a -> Get a
traceShow :: forall a. Show a => String -> Get a -> Get a
traceShow String
s Get a
g
  | IsBoot -> IsBoot
not IsBoot
enableDebug = Get a
g
  | IsBoot
otherwise = do
    a
a <- Get a
g
    String -> Get ()
traceGet (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a)
    a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

runGetIncremental :: Get a -> G.Decoder a
runGetIncremental :: forall a. Get a -> Decoder a
runGetIncremental Get a
g = Get a -> Decoder a
forall a. Get a -> Decoder a
G.runGetIncremental (Get a -> IfaceGetState -> Get a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Get a
g IfaceGetState
emptyState)
  where
    emptyState :: IfaceGetState
emptyState = IsBoot -> IfaceGetState
IfaceGetState IsBoot
False

getByteString :: Int -> Get ByteString
getByteString :: Int -> Get ModuleName
getByteString Int
i = Get ModuleName -> Get ModuleName
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Get ModuleName
G.getByteString Int
i)

getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = Get Word8 -> Get Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Word8
G.getWord8

bytesRead :: Get Int64
bytesRead :: Get Int64
bytesRead = Get Int64 -> Get Int64
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Int64
G.bytesRead

skip :: Int -> Get ()
skip :: Int -> Get ()
skip = Get () -> Get ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Get () -> Get ()) -> (Int -> Get ()) -> Int -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get ()
G.skip

uleb :: Get a -> Get a -> Get a
uleb :: forall a. Get a -> Get a -> Get a
uleb Get a
f Get a
g = do
  IsBoot
c <- (IfaceGetState -> IsBoot) -> StateT IfaceGetState Get IsBoot
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IfaceGetState -> IsBoot
useLEB128
  if IsBoot
c then Get a
f else Get a
g

getWord32be :: Get Word32
getWord32be :: Get Word32
getWord32be = Get Word32 -> Get Word32 -> Get Word32
forall a. Get a -> Get a -> Get a
uleb Get Word32
forall a. (Integral a, FiniteBits a) => Get a
getULEB128 (Get Word32 -> Get Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Word32
G.getWord32be)

getWord64be :: Get Word64
getWord64be :: Get Word64
getWord64be = Get Word64 -> Get Word64 -> Get Word64
forall a. Get a -> Get a -> Get a
uleb Get Word64
forall a. (Integral a, FiniteBits a) => Get a
getULEB128 (Get Word64 -> Get Word64
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Word64
G.getWord64be)

getInt64be :: Get Int64
getInt64be :: Get Int64
getInt64be = Get Int64 -> Get Int64 -> Get Int64
forall a. Get a -> Get a -> Get a
uleb Get Int64
forall a. (Integral a, FiniteBits a) => Get a
getSLEB128 (Get Int64 -> Get Int64
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Int64
G.getInt64be)

lookAhead :: Get b -> Get b
lookAhead :: forall b. Get b -> Get b
lookAhead Get b
g = do
  IfaceGetState
s <- StateT IfaceGetState Get IfaceGetState
forall s (m :: * -> *). MonadState s m => m s
get
  Get b -> Get b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Get b -> Get b) -> Get b -> Get b
forall a b. (a -> b) -> a -> b
$ Get b -> Get b
forall a. Get a -> Get a
G.lookAhead (Get b -> IfaceGetState -> Get b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Get b
g IfaceGetState
s)

getPtr :: Get Word32
getPtr :: Get Word32
getPtr = Get Word32 -> Get Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Word32
G.getWord32be

type IsBoot = Bool

type ModuleName = ByteString

newtype List a = List
    { forall a. List a -> [a]
unList :: [a]
    } deriving newtype (Int -> List a -> ShowS
[List a] -> ShowS
List a -> String
(Int -> List a -> ShowS)
-> (List a -> String) -> ([List a] -> ShowS) -> Show (List a)
forall a. Show a => Int -> List a -> ShowS
forall a. Show a => [List a] -> ShowS
forall a. Show a => List a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List a] -> ShowS
$cshowList :: forall a. Show a => [List a] -> ShowS
show :: List a -> String
$cshow :: forall a. Show a => List a -> String
showsPrec :: Int -> List a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> List a -> ShowS
Show, List a -> ()
(List a -> ()) -> NFData (List a)
forall a. NFData a => List a -> ()
forall a. (a -> ()) -> NFData a
rnf :: List a -> ()
$crnf :: forall a. NFData a => List a -> ()
NFData)

newtype Dictionary = Dictionary
    { Dictionary -> Vector ModuleName
unDictionary :: V.Vector ByteString
    } deriving newtype (Int -> Dictionary -> ShowS
[Dictionary] -> ShowS
Dictionary -> String
(Int -> Dictionary -> ShowS)
-> (Dictionary -> String)
-> ([Dictionary] -> ShowS)
-> Show Dictionary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dictionary] -> ShowS
$cshowList :: [Dictionary] -> ShowS
show :: Dictionary -> String
$cshow :: Dictionary -> String
showsPrec :: Int -> Dictionary -> ShowS
$cshowsPrec :: Int -> Dictionary -> ShowS
Show, Dictionary -> ()
(Dictionary -> ()) -> NFData Dictionary
forall a. (a -> ()) -> NFData a
rnf :: Dictionary -> ()
$crnf :: Dictionary -> ()
NFData)

newtype Module = Module
    { Module -> ModuleName
unModule :: ModuleName
    } deriving newtype (Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> String
$cshow :: Module -> String
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show, Module -> ()
(Module -> ()) -> NFData Module
forall a. (a -> ()) -> NFData a
rnf :: Module -> ()
$crnf :: Module -> ()
NFData)

newtype Usage = Usage
    { Usage -> String
unUsage :: FilePath
    } deriving newtype (Int -> Usage -> ShowS
[Usage] -> ShowS
Usage -> String
(Int -> Usage -> ShowS)
-> (Usage -> String) -> ([Usage] -> ShowS) -> Show Usage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Usage] -> ShowS
$cshowList :: [Usage] -> ShowS
show :: Usage -> String
$cshow :: Usage -> String
showsPrec :: Int -> Usage -> ShowS
$cshowsPrec :: Int -> Usage -> ShowS
Show, Usage -> ()
(Usage -> ()) -> NFData Usage
forall a. (a -> ()) -> NFData a
rnf :: Usage -> ()
$crnf :: Usage -> ()
NFData)

data Dependencies = Dependencies
    { Dependencies -> List (ModuleName, IsBoot)
dmods    :: List (ModuleName, IsBoot)
    , Dependencies -> List (ModuleName, IsBoot)
dpkgs    :: List (ModuleName, Bool)
    , Dependencies -> List Module
dorphs   :: List Module
    , Dependencies -> List Module
dfinsts  :: List Module
    , Dependencies -> List ModuleName
dplugins :: List ModuleName
    } deriving (Int -> Dependencies -> ShowS
[Dependencies] -> ShowS
Dependencies -> String
(Int -> Dependencies -> ShowS)
-> (Dependencies -> String)
-> ([Dependencies] -> ShowS)
-> Show Dependencies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependencies] -> ShowS
$cshowList :: [Dependencies] -> ShowS
show :: Dependencies -> String
$cshow :: Dependencies -> String
showsPrec :: Int -> Dependencies -> ShowS
$cshowsPrec :: Int -> Dependencies -> ShowS
Show, (forall x. Dependencies -> Rep Dependencies x)
-> (forall x. Rep Dependencies x -> Dependencies)
-> Generic Dependencies
forall x. Rep Dependencies x -> Dependencies
forall x. Dependencies -> Rep Dependencies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dependencies x -> Dependencies
$cfrom :: forall x. Dependencies -> Rep Dependencies x
Generic)
instance NFData Dependencies

data Interface = Interface
    { Interface -> Dependencies
deps  :: Dependencies
    , Interface -> List Usage
usage :: List Usage
    } deriving (Int -> Interface -> ShowS
[Interface] -> ShowS
Interface -> String
(Int -> Interface -> ShowS)
-> (Interface -> String)
-> ([Interface] -> ShowS)
-> Show Interface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interface] -> ShowS
$cshowList :: [Interface] -> ShowS
show :: Interface -> String
$cshow :: Interface -> String
showsPrec :: Int -> Interface -> ShowS
$cshowsPrec :: Int -> Interface -> ShowS
Show, (forall x. Interface -> Rep Interface x)
-> (forall x. Rep Interface x -> Interface) -> Generic Interface
forall x. Rep Interface x -> Interface
forall x. Interface -> Rep Interface x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Interface x -> Interface
$cfrom :: forall x. Interface -> Rep Interface x
Generic)
instance NFData Interface

-- | Read a block prefixed with its length

withBlockPrefix :: Get a -> Get a
withBlockPrefix :: forall b. Get b -> Get b
withBlockPrefix Get a
f = Get Word32
getPtr Get Word32 -> Get a -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get a
f

getBool :: Get Bool
getBool :: StateT IfaceGetState Get IsBoot
getBool = Int -> IsBoot
forall a. Enum a => Int -> a
toEnum (Int -> IsBoot) -> (Word8 -> Int) -> Word8 -> IsBoot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> IsBoot) -> Get Word8 -> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

getString :: Get String
getString :: Get String
getString = (Word32 -> Char) -> [Word32] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr (Int -> Char) -> (Word32 -> Int) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word32] -> String)
-> (List Word32 -> [Word32]) -> List Word32 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List Word32 -> [Word32]
forall a. List a -> [a]
unList (List Word32 -> String)
-> StateT IfaceGetState Get (List Word32) -> Get String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32 -> StateT IfaceGetState Get (List Word32)
forall a. Get a -> Get (List a)
getList Get Word32
getWord32be

getMaybe :: Get a -> Get (Maybe a)
getMaybe :: forall a. Get a -> Get (Maybe a)
getMaybe Get a
f = StateT IfaceGetState Get (Maybe a)
-> StateT IfaceGetState Get (Maybe a)
-> IsBoot
-> StateT IfaceGetState Get (Maybe a)
forall a. a -> a -> IsBoot -> a
bool (Maybe a -> StateT IfaceGetState Get (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Get a -> StateT IfaceGetState Get (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
f) (IsBoot -> StateT IfaceGetState Get (Maybe a))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT IfaceGetState Get IsBoot
getBool

getList :: Get a -> Get (List a)
getList :: forall a. Get a -> Get (List a)
getList Get a
f = do
  IsBoot
use_uleb <- (IfaceGetState -> IsBoot) -> StateT IfaceGetState Get IsBoot
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IfaceGetState -> IsBoot
useLEB128
  if IsBoot
use_uleb
    then do
      Int64
l <- (Get Int64
forall a. (Integral a, FiniteBits a) => Get a
getSLEB128 :: Get Int64)
      [a] -> List a
forall a. [a] -> List a
List ([a] -> List a) -> StateT IfaceGetState Get [a] -> Get (List a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get a -> StateT IfaceGetState Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
l) Get a
f
    else do
      Word8
i <- Get Word8
getWord8
      Word32
l <-
          if Word8
i Word8 -> Word8 -> IsBoot
forall a. Eq a => a -> a -> IsBoot
== Word8
0xff
              then Get Word32
getWord32be
              else Word32 -> Get Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i :: Word32)
      [a] -> List a
forall a. [a] -> List a
List ([a] -> List a) -> StateT IfaceGetState Get [a] -> Get (List a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get a -> StateT IfaceGetState Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l) Get a
f

getTuple :: Get a -> Get b -> Get (a, b)
getTuple :: forall a b. Get a -> Get b -> Get (a, b)
getTuple Get a
f Get b
g = (,) (a -> b -> (a, b))
-> Get a -> StateT IfaceGetState Get (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
f StateT IfaceGetState Get (b -> (a, b))
-> Get b -> StateT IfaceGetState Get (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get b
g

getByteStringSized :: Get ByteString
getByteStringSized :: Get ModuleName
getByteStringSized = do
    Int64
size <- Get Int64
getInt64be
    Int -> Get ModuleName
getByteString (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size)

getDictionary :: Int -> Get Dictionary
getDictionary :: Int -> Get Dictionary
getDictionary Int
ptr = do
    Int64
offset <- Get Int64
bytesRead
    Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Int
ptr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offset
    Int
size <- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Get Int64 -> StateT IfaceGetState Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
    String -> Get ()
traceGet (String
"Dictionary size: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size)
    Dictionary
dict <- Vector ModuleName -> Dictionary
Dictionary (Vector ModuleName -> Dictionary)
-> StateT IfaceGetState Get (Vector ModuleName) -> Get Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Get ModuleName -> StateT IfaceGetState Get (Vector ModuleName)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
size Get ModuleName
getByteStringSized
    String -> Get ()
traceGet (String
"Dictionary: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dictionary -> String
forall a. Show a => a -> String
show Dictionary
dict)
    Dictionary -> Get Dictionary
forall (m :: * -> *) a. Monad m => a -> m a
return Dictionary
dict

getCachedBS :: Dictionary -> Get ByteString
getCachedBS :: Dictionary -> Get ModuleName
getCachedBS Dictionary
d = Word32 -> Get ModuleName
forall {a} {f :: * -> *}.
(Integral a, MonadFail f, Show a) =>
a -> f ModuleName
go (Word32 -> Get ModuleName) -> Get Word32 -> Get ModuleName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Get Word32 -> Get Word32
forall a. Show a => String -> Get a -> Get a
traceShow String
"Dict index:" Get Word32
getWord32be
  where
    go :: a -> f ModuleName
go a
i =
        case Dictionary -> Vector ModuleName
unDictionary Dictionary
d Vector ModuleName -> Int -> Maybe ModuleName
forall a. Vector a -> Int -> Maybe a
V.!? a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i of
            Just ModuleName
bs -> ModuleName -> f ModuleName
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleName
bs
            Maybe ModuleName
Nothing -> String -> f ModuleName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ModuleName) -> String -> f ModuleName
forall a b. (a -> b) -> a -> b
$ String
"Invalid dictionary index: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
i

-- | Get Fingerprint

getFP' :: Get String
getFP' :: Get String
getFP' = do
  Word64
x <- Get Word64
getWord64be
  Word64
y <- Get Word64
getWord64be
  String -> Get String
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
x (Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
y String
""))

getFP :: Get ()
getFP :: Get ()
getFP = Get String -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get String
getFP'

getInterface721 :: Dictionary -> Get Interface
getInterface721 :: Dictionary -> Get Interface
getInterface721 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get Module
-> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        List ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> List ModuleName
forall a. [a] -> List a
List [])
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface741 :: Dictionary -> Get Interface
getInterface741 :: Dictionary -> Get Interface
getInterface741 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get Module
-> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        List ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> List ModuleName
forall a. [a] -> List a
List [])
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
2 -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage)
-> (String -> Usage) -> String -> Maybe Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Usage
Usage (String -> Maybe Usage) -> Get String -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
getString Get (Maybe Usage) -> Get Word64 -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get Word64
getWord64be Get (Maybe Usage) -> Get Word64 -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get Word64
getWord64be
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface761 :: Dictionary -> Get Interface
getInterface761 :: Dictionary -> Get Interface
getInterface761 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get Module
-> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        List ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> List ModuleName
forall a. [a] -> List a
List [])
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
2 -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage)
-> (String -> Usage) -> String -> Maybe Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Usage
Usage (String -> Maybe Usage) -> Get String -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
getString Get (Maybe Usage) -> Get Word64 -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get Word64
getWord64be Get (Maybe Usage) -> Get Word64 -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get Word64
getWord64be
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface781 :: Dictionary -> Get Interface
getInterface781 :: Dictionary -> Get Interface
getInterface781 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get Module
-> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        List ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> List ModuleName
forall a. [a] -> List a
List [])
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
2 -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage)
-> (String -> Usage) -> String -> Maybe Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Usage
Usage (String -> Maybe Usage) -> Get String -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
getString Get (Maybe Usage) -> Get () -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
getFP
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface801 :: Dictionary -> Get Interface
getInterface801 :: Dictionary -> Get Interface
getInterface801 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    Get Word8 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word8
getWord8
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get Module
-> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        List ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> List ModuleName
forall a. [a] -> List a
List [])
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
2 -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage)
-> (String -> Usage) -> String -> Maybe Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Usage
Usage (String -> Maybe Usage) -> Get String -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
getString Get (Maybe Usage) -> Get () -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
getFP
                Word8
3 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get () -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface821 :: Dictionary -> Get Interface
getInterface821 :: Dictionary -> Get Interface
getInterface821 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get (Maybe Module) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (Maybe Module) -> Get ())
-> StateT IfaceGetState Get (Maybe Module) -> Get ()
forall a b. (a -> b) -> a -> b
$ StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (Maybe Module)
forall a. Get a -> Get (Maybe a)
getMaybe StateT IfaceGetState Get Module
getModule
    Get Word8 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word8
getWord8
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = do
        Word8
idType <- Get Word8
getWord8
        case Word8
idType of
            Word8
0 -> Get ModuleName -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ModuleName -> Get ()) -> Get ModuleName -> Get ()
forall a b. (a -> b) -> a -> b
$ Dictionary -> Get ModuleName
getCachedBS Dictionary
d
            Word8
_ ->
                StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ())
-> StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall a b. (a -> b) -> a -> b
$
                Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get (List (ModuleName, Module))
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get (ModuleName, Module)
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get Module -> Get (ModuleName, Module)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get Module
getModule)
        ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        List ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> List ModuleName
forall a. [a] -> List a
List [])
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
2 -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage)
-> (String -> Usage) -> String -> Maybe Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Usage
Usage (String -> Maybe Usage) -> Get String -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
getString Get (Maybe Usage) -> Get () -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
getFP
                Word8
3 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get () -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface841 :: Dictionary -> Get Interface
getInterface841 :: Dictionary -> Get Interface
getInterface841 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get (Maybe Module) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (Maybe Module) -> Get ())
-> StateT IfaceGetState Get (Maybe Module) -> Get ()
forall a b. (a -> b) -> a -> b
$ StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (Maybe Module)
forall a. Get a -> Get (Maybe a)
getMaybe StateT IfaceGetState Get Module
getModule
    Get Word8 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word8
getWord8
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
5 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = do
        Word8
idType <- Get Word8
getWord8
        case Word8
idType of
            Word8
0 -> Get ModuleName -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ModuleName -> Get ()) -> Get ModuleName -> Get ()
forall a b. (a -> b) -> a -> b
$ Dictionary -> Get ModuleName
getCachedBS Dictionary
d
            Word8
_ ->
                StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ())
-> StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall a b. (a -> b) -> a -> b
$
                Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get (List (ModuleName, Module))
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get (ModuleName, Module)
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get Module -> Get (ModuleName, Module)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get Module
getModule)
        ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        List ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> List ModuleName
forall a. [a] -> List a
List [])
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
2 -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage)
-> (String -> Usage) -> String -> Maybe Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Usage
Usage (String -> Maybe Usage) -> Get String -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
getString Get (Maybe Usage) -> Get () -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
getFP
                Word8
3 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get () -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface861 :: Dictionary -> Get Interface
getInterface861 :: Dictionary -> Get Interface
getInterface861 Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get (Maybe Module) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (Maybe Module) -> Get ())
-> StateT IfaceGetState Get (Maybe Module) -> Get ()
forall a b. (a -> b) -> a -> b
$ StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (Maybe Module)
forall a. Get a -> Get (Maybe a)
getMaybe StateT IfaceGetState Get Module
getModule
    Get Word8 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word8
getWord8
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
6 Get ()
getFP
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
    Dependencies -> List Usage -> Interface
Interface (Dependencies -> List Usage -> Interface)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get (List Usage -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IfaceGetState Get Dependencies
getDependencies StateT IfaceGetState Get (List Usage -> Interface)
-> StateT IfaceGetState Get (List Usage) -> Get Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT IfaceGetState Get (List Usage)
getUsage
  where
    getModule :: StateT IfaceGetState Get Module
getModule = do
        Word8
idType <- Get Word8
getWord8
        case Word8
idType of
            Word8
0 -> Get ModuleName -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ModuleName -> Get ()) -> Get ModuleName -> Get ()
forall a b. (a -> b) -> a -> b
$ Dictionary -> Get ModuleName
getCachedBS Dictionary
d
            Word8
_ ->
                StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ())
-> StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall a b. (a -> b) -> a -> b
$
                Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get (List (ModuleName, Module))
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get (ModuleName, Module)
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get Module -> Get (ModuleName, Module)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get Module
getModule)
        ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$
        List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies (List (ModuleName, IsBoot)
 -> List (ModuleName, IsBoot)
 -> List Module
 -> List Module
 -> List ModuleName
 -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List (ModuleName, IsBoot)
      -> List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List (ModuleName, IsBoot)
   -> List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT
     IfaceGetState
     Get
     (List Module -> List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool) StateT
  IfaceGetState
  Get
  (List Module -> List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT
     IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT
  IfaceGetState Get (List Module -> List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List Module)
-> StateT IfaceGetState Get (List ModuleName -> Dependencies)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get (List ModuleName -> Dependencies)
-> StateT IfaceGetState Get (List ModuleName)
-> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Get ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall a. Get a -> Get (List a)
getList (Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
1 ->
                    Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get ()
-> StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP StateT IfaceGetState Get (Maybe ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP) StateT IfaceGetState Get (List (ModuleName, ()))
-> StateT IfaceGetState Get IsBoot
-> StateT IfaceGetState Get IsBoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                    StateT IfaceGetState Get IsBoot
getBool StateT IfaceGetState Get IsBoot -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
2 -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage)
-> (String -> Usage) -> String -> Maybe Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Usage
Usage (String -> Maybe Usage) -> Get String -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
getString Get (Maybe Usage) -> Get () -> Get (Maybe Usage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
getFP
                Word8
3 -> StateT IfaceGetState Get Module
getModule StateT IfaceGetState Get Module -> Get () -> Get ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ()
getFP Get () -> Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Usage
forall a. Maybe a
Nothing
                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterfaceRecent :: IfaceVersion -> Dictionary -> Get Interface
getInterfaceRecent :: IfaceVersion -> Dictionary -> Get Interface
getInterfaceRecent IfaceVersion
version Dictionary
d = do
    StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get Module -> Get ())
-> StateT IfaceGetState Get Module -> Get ()
forall a b. (a -> b) -> a -> b
$ String
-> StateT IfaceGetState Get Module
-> StateT IfaceGetState Get Module
forall a. Show a => String -> Get a -> Get a
traceShow String
"Module:" StateT IfaceGetState Get Module
getModule
    StateT IfaceGetState Get (Maybe Module) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (Maybe Module) -> Get ())
-> StateT IfaceGetState Get (Maybe Module) -> Get ()
forall a b. (a -> b) -> a -> b
$ String
-> StateT IfaceGetState Get (Maybe Module)
-> StateT IfaceGetState Get (Maybe Module)
forall a. Show a => String -> Get a -> Get a
traceShow String
"Sig:" (StateT IfaceGetState Get (Maybe Module)
 -> StateT IfaceGetState Get (Maybe Module))
-> StateT IfaceGetState Get (Maybe Module)
-> StateT IfaceGetState Get (Maybe Module)
forall a b. (a -> b) -> a -> b
$ StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (Maybe Module)
forall a. Get a -> Get (Maybe a)
getMaybe StateT IfaceGetState Get Module
getModule
    Get Word8 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word8
getWord8 -- hsc_src

    Get ()
getFP         -- iface_hash

    Get ()
getFP         -- mod_hash

    Get ()
getFP         -- flag_hash

    Get ()
getFP         -- opt_hash

    Get ()
getFP         -- hpc_hash

    Get ()
getFP         -- plugin_hash

    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool  -- orphan

    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool  -- hasFamInsts

    Dependencies
ddeps  <- String
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a. Show a => String -> Get a -> Get a
traceShow String
"Dependencies:" StateT IfaceGetState Get Dependencies
getDependencies
    List Usage
dusage <- String
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a. Show a => String -> Get a -> Get a
traceShow String
"Usage:"        StateT IfaceGetState Get (List Usage)
getUsage
    Interface -> Get Interface
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dependencies -> List Usage -> Interface
Interface Dependencies
ddeps List Usage
dusage)
  where
    getModule :: StateT IfaceGetState Get Module
getModule = do
        Word8
idType <- String -> Get Word8 -> Get Word8
forall a. Show a => String -> Get a -> Get a
traceShow String
"Unit type:" Get Word8
getWord8
        case Word8
idType of
            Word8
0 -> Get ModuleName -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ModuleName -> Get ()) -> Get ModuleName -> Get ()
forall a b. (a -> b) -> a -> b
$ Dictionary -> Get ModuleName
getCachedBS Dictionary
d
            Word8
1 ->
                StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ())
-> StateT IfaceGetState Get (List (ModuleName, Module)) -> Get ()
forall a b. (a -> b) -> a -> b
$
                Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> StateT IfaceGetState Get (List (ModuleName, Module))
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get (ModuleName, Module)
-> StateT IfaceGetState Get (List (ModuleName, Module))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get Module -> Get (ModuleName, Module)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get Module
getModule)
            Word8
_ -> String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid unit type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
idType
        ModuleName -> Module
Module (ModuleName -> Module)
-> Get ModuleName -> StateT IfaceGetState Get Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dictionary -> Get ModuleName
getCachedBS Dictionary
d
    getDependencies :: StateT IfaceGetState Get Dependencies
getDependencies =
        StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get Dependencies
 -> StateT IfaceGetState Get Dependencies)
-> StateT IfaceGetState Get Dependencies
-> StateT IfaceGetState Get Dependencies
forall a b. (a -> b) -> a -> b
$ do
          if IfaceVersion
version IfaceVersion -> IfaceVersion -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= IfaceVersion
V9041
            then do
              -- warning: transitive dependencies are no longer stored,

              -- only direct imports!

              -- Modules are now prefixed with their UnitId (should have been

              -- ModuleWithIsBoot...)

              List (ModuleName, IsBoot)
direct_mods <- String
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Show a => String -> Get a -> Get a
traceShow String
"direct_mods:" (StateT IfaceGetState Get (List (ModuleName, IsBoot))
 -> StateT IfaceGetState Get (List (ModuleName, IsBoot)))
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a b. (a -> b) -> a -> b
$ Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> Get (ModuleName, IsBoot) -> Get (ModuleName, IsBoot)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool)
              List ModuleName
direct_pkgs <- Get ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall a. Get a -> Get (List a)
getList (Dictionary -> Get ModuleName
getCachedBS Dictionary
d)

              -- plugin packages are now stored separately

              List ModuleName
plugin_pkgs <- Get ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall a. Get a -> Get (List a)
getList (Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
              let all_pkgs :: [ModuleName]
all_pkgs = List ModuleName -> [ModuleName]
forall a. List a -> [a]
unList List ModuleName
plugin_pkgs [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ List ModuleName -> [ModuleName]
forall a. List a -> [a]
unList List ModuleName
direct_pkgs

              -- instead of a trust bool for each unit, we have an additional

              -- list of trusted units (transitive)

              List ModuleName
trusted_pkgs <- Get ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall a. Get a -> Get (List a)
getList (Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
              let trusted :: ModuleName -> IsBoot
trusted ModuleName
u = ModuleName
u ModuleName -> [ModuleName] -> IsBoot
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsBoot
`elem` List ModuleName -> [ModuleName]
forall a. List a -> [a]
unList List ModuleName
trusted_pkgs
              let all_pkgs_trust :: List (ModuleName, IsBoot)
all_pkgs_trust = [(ModuleName, IsBoot)] -> List (ModuleName, IsBoot)
forall a. [a] -> List a
List ([ModuleName] -> [IsBoot] -> [(ModuleName, IsBoot)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ModuleName]
all_pkgs ((ModuleName -> IsBoot) -> [ModuleName] -> [IsBoot]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> IsBoot
trusted [ModuleName]
all_pkgs))

              -- these are new

              List Module
_sig_mods  <- StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule
              List (ModuleName, IsBoot)
_boot_mods <- Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Dictionary -> Get ModuleName
getCachedBS Dictionary
d Get ModuleName
-> Get (ModuleName, IsBoot) -> Get (ModuleName, IsBoot)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool)

              List Module
dep_orphs  <- StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule
              List Module
dep_finsts <- StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule

              -- plugin names are no longer stored here

              let dep_plgins :: List a
dep_plgins = [a] -> List a
forall a. [a] -> List a
List []

              Dependencies -> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies List (ModuleName, IsBoot)
direct_mods List (ModuleName, IsBoot)
all_pkgs_trust List Module
dep_orphs List Module
dep_finsts List ModuleName
forall {a}. List a
dep_plgins)
            else do
              List (ModuleName, IsBoot)
dep_mods   <- Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool)
              List (ModuleName, IsBoot)
dep_pkgs   <- Get (ModuleName, IsBoot)
-> StateT IfaceGetState Get (List (ModuleName, IsBoot))
forall a. Get a -> Get (List a)
getList (Get ModuleName
-> StateT IfaceGetState Get IsBoot -> Get (ModuleName, IsBoot)
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Dictionary -> Get ModuleName
getCachedBS Dictionary
d) StateT IfaceGetState Get IsBoot
getBool)
              List Module
dep_orphs  <- StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule
              List Module
dep_finsts <- StateT IfaceGetState Get Module
-> StateT IfaceGetState Get (List Module)
forall a. Get a -> Get (List a)
getList StateT IfaceGetState Get Module
getModule
              List ModuleName
dep_plgins <- Get ModuleName -> StateT IfaceGetState Get (List ModuleName)
forall a. Get a -> Get (List a)
getList (Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
              Dependencies -> StateT IfaceGetState Get Dependencies
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List (ModuleName, IsBoot)
-> List (ModuleName, IsBoot)
-> List Module
-> List Module
-> List ModuleName
-> Dependencies
Dependencies List (ModuleName, IsBoot)
dep_mods List (ModuleName, IsBoot)
dep_pkgs List Module
dep_orphs List Module
dep_finsts List ModuleName
dep_plgins)

    getUsage :: StateT IfaceGetState Get (List Usage)
getUsage = StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall b. Get b -> Get b
withBlockPrefix (StateT IfaceGetState Get (List Usage)
 -> StateT IfaceGetState Get (List Usage))
-> StateT IfaceGetState Get (List Usage)
-> StateT IfaceGetState Get (List Usage)
forall a b. (a -> b) -> a -> b
$ [Usage] -> List Usage
forall a. [a] -> List a
List ([Usage] -> List Usage)
-> (List (Maybe Usage) -> [Usage])
-> List (Maybe Usage)
-> List Usage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage])
-> (List (Maybe Usage) -> [Maybe Usage])
-> List (Maybe Usage)
-> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Maybe Usage) -> [Maybe Usage]
forall a. List a -> [a]
unList (List (Maybe Usage) -> List Usage)
-> StateT IfaceGetState Get (List (Maybe Usage))
-> StateT IfaceGetState Get (List Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Usage) -> StateT IfaceGetState Get (List (Maybe Usage))
forall a. Get a -> Get (List a)
getList Get (Maybe Usage)
go
      where
        go :: Get (Maybe Usage)
        go :: Get (Maybe Usage)
go = do
            Word8
usageType <- String -> Get Word8 -> Get Word8
forall a. Show a => String -> Get a -> Get a
traceShow String
"Usage type:" Get Word8
getWord8
            case Word8
usageType of
                Word8
0 -> do
                  StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String
-> StateT IfaceGetState Get Module
-> StateT IfaceGetState Get Module
forall a. Show a => String -> Get a -> Get a
traceShow String
"Module:" StateT IfaceGetState Get Module
getModule)
                  Get () -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get ()
getFP
                  StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
                  Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Usage
forall a. Maybe a
Nothing

                Word8
1 -> do
                    Get ModuleName -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> Get ModuleName -> Get ModuleName
forall a. Show a => String -> Get a -> Get a
traceShow String
"Home module:" (Dictionary -> Get ModuleName
getCachedBS Dictionary
d))
                    Get () -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get ()
getFP
                    StateT IfaceGetState Get (Maybe ()) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get () -> StateT IfaceGetState Get (Maybe ())
forall a. Get a -> Get (Maybe a)
getMaybe Get ()
getFP)
                    StateT IfaceGetState Get (List (ModuleName, ())) -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get (ModuleName, ())
-> StateT IfaceGetState Get (List (ModuleName, ()))
forall a. Get a -> Get (List a)
getList (Get ModuleName -> Get () -> Get (ModuleName, ())
forall a b. Get a -> Get b -> Get (a, b)
getTuple (Get Word8
getWord8 Get Word8 -> Get ModuleName -> Get ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Dictionary -> Get ModuleName
getCachedBS Dictionary
d) Get ()
getFP))
                    StateT IfaceGetState Get IsBoot -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get IsBoot
getBool
                    Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Usage
forall a. Maybe a
Nothing

                Word8
2 -> do
                  String
file_path  <- String -> Get String -> Get String
forall a. Show a => String -> Get a -> Get a
traceShow String
"File:" Get String
getString
                  String
_file_hash <- String -> Get String -> Get String
forall a. Show a => String -> Get a -> Get a
traceShow String
"FP:" Get String
getFP'
                  IsBoot -> Get () -> Get ()
forall (f :: * -> *). Applicative f => IsBoot -> f () -> f ()
when (IfaceVersion
version IfaceVersion -> IfaceVersion -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= IfaceVersion
V9041) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
                    Maybe String
_file_label <- String -> Get (Maybe String) -> Get (Maybe String)
forall a. Show a => String -> Get a -> Get a
traceShow String
"File label:" (Get String -> Get (Maybe String)
forall a. Get a -> Get (Maybe a)
getMaybe Get String
getString)
                    () -> Get ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Usage -> Maybe Usage
forall a. a -> Maybe a
Just (String -> Usage
Usage String
file_path))

                Word8
3 -> do
                  StateT IfaceGetState Get Module -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT IfaceGetState Get Module
getModule
                  Get () -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get ()
getFP
                  Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Usage
forall a. Maybe a
Nothing

                Word8
4 | IfaceVersion
version IfaceVersion -> IfaceVersion -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= IfaceVersion
V9041 -> do -- UsageHomeModuleInterface

                  ()
_mod_name   <- Get ModuleName -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Dictionary -> Get ModuleName
getCachedBS Dictionary
d)
                  ()
_iface_hash <- Get () -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get ()
getFP
                  Maybe Usage -> Get (Maybe Usage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Usage
forall a. Maybe a
Nothing

                Word8
_ -> String -> Get (Maybe Usage)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe Usage)) -> String -> Get (Maybe Usage)
forall a b. (a -> b) -> a -> b
$ String
"Invalid usageType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
usageType

getInterface :: Get Interface
getInterface :: Get Interface
getInterface = do
    let enableLEB128 :: Get ()
enableLEB128 = (IfaceGetState -> IfaceGetState) -> Get ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\IfaceGetState
c -> IfaceGetState
c { useLEB128 :: IsBoot
useLEB128 = IsBoot
True})

    Word32
magic <- Get Word32 -> Get Word32
forall b. Get b -> Get b
lookAhead Get Word32
getWord32be Get Word32 -> (Word32 -> Get Word32) -> Get Word32
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        -- normal magic

        Word32
0x1face      -> Get Word32
getWord32be
        Word32
0x1face64    -> Get Word32
getWord32be
        Word32
m            -> do
          -- GHC 8.10 mistakenly encoded header fields with LEB128

          -- so it gets special treatment

          Get Word32 -> Get Word32
forall b. Get b -> Get b
lookAhead (Get ()
enableLEB128 Get () -> Get Word32 -> Get Word32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get Word32
getWord32be) Get Word32 -> (Word32 -> Get Word32) -> Get Word32
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Word32
0x1face      -> Get ()
enableLEB128 Get () -> Get Word32 -> Get Word32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get Word32
getWord32be
            Word32
0x1face64    -> Get ()
enableLEB128 Get () -> Get Word32 -> Get Word32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get Word32
getWord32be
            Word32
_            -> String -> Get Word32
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Word32) -> String -> Get Word32
forall a b. (a -> b) -> a -> b
$ String
"Invalid magic: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
m String
""

    String -> Get ()
traceGet (String
"Magic: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
magic String
"")

    -- empty field (removed in 9.0...)

    case Word32
magic of
        Word32
0x1face      -> do
          Word32
e <- Get Word32 -> Get Word32
forall b. Get b -> Get b
lookAhead Get Word32
getWord32be
          if Word32
e Word32 -> Word32 -> IsBoot
forall a. Eq a => a -> a -> IsBoot
== Word32
0
            then Get Word32 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word32
getWord32be
            else Get ()
enableLEB128 -- > 9.0

        Word32
0x1face64    -> do
          Word64
e <- Get Word64 -> Get Word64
forall b. Get b -> Get b
lookAhead Get Word64
getWord64be
          if Word64
e Word64 -> Word64 -> IsBoot
forall a. Eq a => a -> a -> IsBoot
== Word64
0
            then Get Word64 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word64
getWord64be
            else Get ()
enableLEB128 -- > 9.0

        Word32
_            -> () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- ghc version

    String
version <- Get String
getString
    String -> Get ()
traceGet (String
"Version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
version)

    let !ifaceVersion :: IfaceVersion
ifaceVersion
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"9041" = IfaceVersion
V9041
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"9001" = IfaceVersion
V9001
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"8101" = IfaceVersion
V8101
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"8061" = IfaceVersion
V8061
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"8041" = IfaceVersion
V8041
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"8021" = IfaceVersion
V8021
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"8001" = IfaceVersion
V8001
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"7081" = IfaceVersion
V7081
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"7061" = IfaceVersion
V7061
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"7041" = IfaceVersion
V7041
          | String
version String -> String -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= String
"7021" = IfaceVersion
V7021
          | IsBoot
otherwise         = String -> IfaceVersion
forall a. HasCallStack => String -> a
error (String -> IfaceVersion) -> String -> IfaceVersion
forall a b. (a -> b) -> a -> b
$ String
"Unsupported version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
version

    -- way

    String
way <- Get String
getString
    String -> Get ()
traceGet (String
"Ways: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
way)

    -- source hash (GHC >= 9.4)

    IsBoot -> Get () -> Get ()
forall (f :: * -> *). Applicative f => IsBoot -> f () -> f ()
when (IfaceVersion
ifaceVersion IfaceVersion -> IfaceVersion -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= IfaceVersion
V9041) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ Get () -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get ()
getFP

    -- extensible fields (GHC >= 9.0)

    IsBoot -> Get () -> Get ()
forall (f :: * -> *). Applicative f => IsBoot -> f () -> f ()
when (IfaceVersion
ifaceVersion IfaceVersion -> IfaceVersion -> IsBoot
forall a. Ord a => a -> a -> IsBoot
>= IfaceVersion
V9001) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ Get Word32 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word32
getPtr

    -- dict_ptr

    Word32
dictPtr <- Get Word32
getPtr
    String -> Get ()
traceGet (String
"Dict ptr: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
dictPtr)

    -- dict

    Dictionary
dict <- Get Dictionary -> Get Dictionary
forall b. Get b -> Get b
lookAhead (Get Dictionary -> Get Dictionary)
-> Get Dictionary -> Get Dictionary
forall a b. (a -> b) -> a -> b
$ Int -> Get Dictionary
getDictionary (Int -> Get Dictionary) -> Int -> Get Dictionary
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dictPtr

    -- symtable_ptr

    Get Word32 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word32
getPtr

    case IfaceVersion
ifaceVersion of
      IfaceVersion
V9041 -> IfaceVersion -> Dictionary -> Get Interface
getInterfaceRecent IfaceVersion
ifaceVersion Dictionary
dict
      IfaceVersion
V9001 -> IfaceVersion -> Dictionary -> Get Interface
getInterfaceRecent IfaceVersion
ifaceVersion Dictionary
dict
      IfaceVersion
V8101 -> IfaceVersion -> Dictionary -> Get Interface
getInterfaceRecent IfaceVersion
ifaceVersion Dictionary
dict
      IfaceVersion
V8061 -> Dictionary -> Get Interface
getInterface861 Dictionary
dict
      IfaceVersion
V8041 -> Dictionary -> Get Interface
getInterface841 Dictionary
dict
      IfaceVersion
V8021 -> Dictionary -> Get Interface
getInterface821 Dictionary
dict
      IfaceVersion
V8001 -> Dictionary -> Get Interface
getInterface801 Dictionary
dict
      IfaceVersion
V7081 -> Dictionary -> Get Interface
getInterface781 Dictionary
dict
      IfaceVersion
V7061 -> Dictionary -> Get Interface
getInterface761 Dictionary
dict
      IfaceVersion
V7041 -> Dictionary -> Get Interface
getInterface741 Dictionary
dict
      IfaceVersion
V7021 -> Dictionary -> Get Interface
getInterface721 Dictionary
dict


fromFile :: FilePath -> IO (Either String Interface)
fromFile :: String -> IO (Either String Interface)
fromFile String
fp = String
-> IOMode
-> (Handle -> IO (Either String Interface))
-> IO (Either String Interface)
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fp IOMode
ReadMode Handle -> IO (Either String Interface)
forall {f :: * -> *}.
MonadIO f =>
Handle -> f (Either String Interface)
go
  where
    go :: Handle -> f (Either String Interface)
go Handle
h =
      let feed :: Decoder b -> f (Either String b)
feed (G.Done ModuleName
_ Int64
_ b
iface) = Either String b -> f (Either String b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String b -> f (Either String b))
-> Either String b -> f (Either String b)
forall a b. (a -> b) -> a -> b
$ b -> Either String b
forall a b. b -> Either a b
Right b
iface
          feed (G.Fail ModuleName
_ Int64
_ String
msg) = Either String b -> f (Either String b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String b -> f (Either String b))
-> Either String b -> f (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left String
msg
          feed (G.Partial Maybe ModuleName -> Decoder b
k) = do
            ModuleName
chunk <- Handle -> Int -> f ModuleName
forall (m :: * -> *). MonadIO m => Handle -> Int -> m ModuleName
hGetSome Handle
h Int
defaultChunkSize
            Decoder b -> f (Either String b)
feed (Decoder b -> f (Either String b))
-> Decoder b -> f (Either String b)
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> Decoder b
k (Maybe ModuleName -> Decoder b) -> Maybe ModuleName -> Decoder b
forall a b. (a -> b) -> a -> b
$ if ModuleName -> IsBoot
B.null ModuleName
chunk then Maybe ModuleName
forall a. Maybe a
Nothing else ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
chunk
      in Decoder Interface -> f (Either String Interface)
forall {f :: * -> *} {b}.
MonadIO f =>
Decoder b -> f (Either String b)
feed (Decoder Interface -> f (Either String Interface))
-> Decoder Interface -> f (Either String Interface)
forall a b. (a -> b) -> a -> b
$ Get Interface -> Decoder Interface
forall a. Get a -> Decoder a
runGetIncremental Get Interface
getInterface


getULEB128 :: forall a. (Integral a, FiniteBits a) => Get a
getULEB128 :: forall a. (Integral a, FiniteBits a) => Get a
getULEB128 =
    Int -> a -> Get a
go Int
0 a
0
  where
    go :: Int -> a -> Get a
    go :: Int -> a -> Get a
go Int
shift a
w = do
        Word8
b <- Get Word8
getWord8
        let !hasMore :: IsBoot
hasMore = Word8 -> Int -> IsBoot
forall a. Bits a => a -> Int -> IsBoot
testBit Word8
b Int
7
        let !val :: a
val = a
w a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Int
7 a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift) :: a
        if IsBoot
hasMore
            then do
                Int -> a -> Get a
go (Int
shiftInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
7) a
val
            else
                a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
val

getSLEB128 :: forall a. (Integral a, FiniteBits a) => Get a
getSLEB128 :: forall a. (Integral a, FiniteBits a) => Get a
getSLEB128 = do
    (a
val,Int
shift,IsBoot
signed) <- Int -> a -> Get (a, Int, IsBoot)
go Int
0 a
0
    if IsBoot
signed IsBoot -> IsBoot -> IsBoot
&& (Int
shift Int -> Int -> IsBoot
forall a. Ord a => a -> a -> IsBoot
< a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
val )
        then a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! ((a -> a
forall a. Bits a => a -> a
complement a
0 a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift) a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
val)
        else a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
    where
        go :: Int -> a -> Get (a,Int,Bool)
        go :: Int -> a -> Get (a, Int, IsBoot)
go Int
shift a
val = do
            Word8
byte <- Get Word8
getWord8
            let !byteVal :: a
byteVal = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
byte Int
7) :: a
            let !val' :: a
val' = a
val a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
byteVal a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift)
            let !more :: IsBoot
more = Word8 -> Int -> IsBoot
forall a. Bits a => a -> Int -> IsBoot
testBit Word8
byte Int
7
            let !shift' :: Int
shift' = Int
shiftInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
7
            if IsBoot
more
                then Int -> a -> Get (a, Int, IsBoot)
go Int
shift' a
val'
                else do
                    let !signed :: IsBoot
signed = Word8 -> Int -> IsBoot
forall a. Bits a => a -> Int -> IsBoot
testBit Word8
byte Int
6
                    (a, Int, IsBoot) -> Get (a, Int, IsBoot)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
val',Int
shift',IsBoot
signed)