{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe  #-}

-- | Errors from dynamic loading of shared libraries for FFI.
module Cryptol.Backend.FFI.Error where

import           Control.DeepSeq
import qualified Data.List.NonEmpty as NE
import           Data.List.NonEmpty (NonEmpty)
import           GHC.Generics

import           Cryptol.Utils.PP
import           Cryptol.ModuleSystem.Name

data FFILoadError
  = CantLoadFFISrc
    FilePath -- ^ Path to cryptol module
    String   -- ^ Error message
  | CantLoadFFIImpl
    String   -- ^ Function name
    String   -- ^ Error message
  | FFIDuplicates (NonEmpty Name)
  | FFIInFunctor  Name
  deriving (Int -> FFILoadError -> ShowS
[FFILoadError] -> ShowS
FFILoadError -> String
(Int -> FFILoadError -> ShowS)
-> (FFILoadError -> String)
-> ([FFILoadError] -> ShowS)
-> Show FFILoadError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FFILoadError -> ShowS
showsPrec :: Int -> FFILoadError -> ShowS
$cshow :: FFILoadError -> String
show :: FFILoadError -> String
$cshowList :: [FFILoadError] -> ShowS
showList :: [FFILoadError] -> ShowS
Show, (forall x. FFILoadError -> Rep FFILoadError x)
-> (forall x. Rep FFILoadError x -> FFILoadError)
-> Generic FFILoadError
forall x. Rep FFILoadError x -> FFILoadError
forall x. FFILoadError -> Rep FFILoadError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FFILoadError -> Rep FFILoadError x
from :: forall x. FFILoadError -> Rep FFILoadError x
$cto :: forall x. Rep FFILoadError x -> FFILoadError
to :: forall x. Rep FFILoadError x -> FFILoadError
Generic, FFILoadError -> ()
(FFILoadError -> ()) -> NFData FFILoadError
forall a. (a -> ()) -> NFData a
$crnf :: FFILoadError -> ()
rnf :: FFILoadError -> ()
NFData)

instance PP FFILoadError where
  ppPrec :: Int -> FFILoadError -> Doc
ppPrec Int
_ FFILoadError
e =
    case FFILoadError
e of
      CantLoadFFISrc String
path String
msg ->
        Doc -> Int -> Doc -> Doc
hang (Doc
"Could not load foreign source for module located at"
              Doc -> Doc -> Doc
<+> String -> Doc
text String
path Doc -> Doc -> Doc
<.> Doc
colon)
          Int
4 (String -> Doc
text String
msg)
      CantLoadFFIImpl String
name String
_msg ->
        Doc
"Could not load foreign implementation for binding" Doc -> Doc -> Doc
<+> String -> Doc
text String
name
        -- We don't print the OS error message for more consistent test output
        -- hang ("Could not load foreign implementation for binding"
        --       <+> text name <.> colon)
        --   4 (text _msg)
      FFIDuplicates NonEmpty Name
xs ->
        Doc -> Int -> Doc -> Doc
hang Doc
"Multiple foreign declarations with the same name:"
           Int
4 (Doc -> Doc
backticks (Ident -> Doc
forall a. PP a => a -> Doc
pp (Name -> Ident
nameIdent (NonEmpty Name -> Name
forall a. NonEmpty a -> a
NE.head NonEmpty Name
xs))) Doc -> Doc -> Doc
<+>
                 Doc
"defined at" Doc -> Doc -> Doc
<+> Doc -> Doc
align ([Doc] -> Doc
vcat ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> Doc
forall a. PP a => a -> Doc
pp (Range -> Doc) -> (Name -> Range) -> Name -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Range
nameLoc) (NonEmpty Name -> [Name]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Name
xs))))
      FFIInFunctor Name
x ->
        Doc -> Int -> Doc -> Doc
hang (Range -> Doc
forall a. PP a => a -> Doc
pp (Name -> Range
nameLoc Name
x) Doc -> Doc -> Doc
<.> Doc
":")
          Int
4 Doc
"Foreign declaration" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (Ident -> Doc
forall a. PP a => a -> Doc
pp (Name -> Ident
nameIdent Name
x)) Doc -> Doc -> Doc
<+>
                Doc
"may not appear in a parameterized module."