{-# LANGUAGE NoRebindableSyntax #-}
module Indigo.Compilation.Hooks
( CommentsVerbosity (..)
, CommentSettings (..)
, defaultCommentSettings
, CommentHooks (..)
, settingsToHooks
) where
import Lens.Micro.TH (makeLensesFor)
import Prelude
import GHC.Stack.Types (SrcLoc(..))
import Indigo.Compilation.Sequential
(InstrCollector(..), Instruction(..), SequentialHooks(..), stmtHookL)
import Indigo.Internal.State
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import qualified Michelson.Typed.Convert as M
import qualified Michelson.Typed.Instr as M
data =
{ CommentSettings -> CommentsVerbosity
csVerbosity :: CommentsVerbosity
, CommentSettings -> Bool
csPrintFullStackTrace :: Bool
, CommentSettings -> Bool
csPrintFileName :: Bool
} deriving stock (CommentSettings -> CommentSettings -> Bool
(CommentSettings -> CommentSettings -> Bool)
-> (CommentSettings -> CommentSettings -> Bool)
-> Eq CommentSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentSettings -> CommentSettings -> Bool
$c/= :: CommentSettings -> CommentSettings -> Bool
== :: CommentSettings -> CommentSettings -> Bool
$c== :: CommentSettings -> CommentSettings -> Bool
Eq, Int -> CommentSettings -> ShowS
[CommentSettings] -> ShowS
CommentSettings -> String
(Int -> CommentSettings -> ShowS)
-> (CommentSettings -> String)
-> ([CommentSettings] -> ShowS)
-> Show CommentSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentSettings] -> ShowS
$cshowList :: [CommentSettings] -> ShowS
show :: CommentSettings -> String
$cshow :: CommentSettings -> String
showsPrec :: Int -> CommentSettings -> ShowS
$cshowsPrec :: Int -> CommentSettings -> ShowS
Show)
defaultCommentSettings :: CommentsVerbosity -> CommentSettings
verb :: CommentsVerbosity
verb = CommentsVerbosity -> Bool -> Bool -> CommentSettings
CommentSettings CommentsVerbosity
verb Bool
False Bool
False
data
=
| LogTopLevelFrontendStatements
| LogBackendStatements
| LogAuxCode
| LogExpressionsComputations
deriving stock (Int -> CommentsVerbosity -> ShowS
[CommentsVerbosity] -> ShowS
CommentsVerbosity -> String
(Int -> CommentsVerbosity -> ShowS)
-> (CommentsVerbosity -> String)
-> ([CommentsVerbosity] -> ShowS)
-> Show CommentsVerbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentsVerbosity] -> ShowS
$cshowList :: [CommentsVerbosity] -> ShowS
show :: CommentsVerbosity -> String
$cshow :: CommentsVerbosity -> String
showsPrec :: Int -> CommentsVerbosity -> ShowS
$cshowsPrec :: Int -> CommentsVerbosity -> ShowS
Show, CommentsVerbosity -> CommentsVerbosity -> Bool
(CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> Eq CommentsVerbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c/= :: CommentsVerbosity -> CommentsVerbosity -> Bool
== :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c== :: CommentsVerbosity -> CommentsVerbosity -> Bool
Eq, Eq CommentsVerbosity
Eq CommentsVerbosity =>
(CommentsVerbosity -> CommentsVerbosity -> Ordering)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity)
-> (CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity)
-> Ord CommentsVerbosity
CommentsVerbosity -> CommentsVerbosity -> Bool
CommentsVerbosity -> CommentsVerbosity -> Ordering
CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
$cmin :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
max :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
$cmax :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
>= :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c>= :: CommentsVerbosity -> CommentsVerbosity -> Bool
> :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c> :: CommentsVerbosity -> CommentsVerbosity -> Bool
<= :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c<= :: CommentsVerbosity -> CommentsVerbosity -> Bool
< :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c< :: CommentsVerbosity -> CommentsVerbosity -> Bool
compare :: CommentsVerbosity -> CommentsVerbosity -> Ordering
$ccompare :: CommentsVerbosity -> CommentsVerbosity -> Ordering
$cp1Ord :: Eq CommentsVerbosity
Ord, CommentsVerbosity
CommentsVerbosity -> CommentsVerbosity -> Bounded CommentsVerbosity
forall a. a -> a -> Bounded a
maxBound :: CommentsVerbosity
$cmaxBound :: CommentsVerbosity
minBound :: CommentsVerbosity
$cminBound :: CommentsVerbosity
Bounded, Int -> CommentsVerbosity
CommentsVerbosity -> Int
CommentsVerbosity -> [CommentsVerbosity]
CommentsVerbosity -> CommentsVerbosity
CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
(CommentsVerbosity -> CommentsVerbosity)
-> (CommentsVerbosity -> CommentsVerbosity)
-> (Int -> CommentsVerbosity)
-> (CommentsVerbosity -> Int)
-> (CommentsVerbosity -> [CommentsVerbosity])
-> (CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity])
-> (CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity])
-> (CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity])
-> Enum CommentsVerbosity
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 :: CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
$cenumFromThenTo :: CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
enumFromTo :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
$cenumFromTo :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
enumFromThen :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
$cenumFromThen :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
enumFrom :: CommentsVerbosity -> [CommentsVerbosity]
$cenumFrom :: CommentsVerbosity -> [CommentsVerbosity]
fromEnum :: CommentsVerbosity -> Int
$cfromEnum :: CommentsVerbosity -> Int
toEnum :: Int -> CommentsVerbosity
$ctoEnum :: Int -> CommentsVerbosity
pred :: CommentsVerbosity -> CommentsVerbosity
$cpred :: CommentsVerbosity -> CommentsVerbosity
succ :: CommentsVerbosity -> CommentsVerbosity
$csucc :: CommentsVerbosity -> CommentsVerbosity
Enum)
instance Default CommentSettings where
def :: CommentSettings
def = CommentsVerbosity -> Bool -> Bool -> CommentSettings
CommentSettings CommentsVerbosity
NoComments Bool
False Bool
False
makeLensesFor [ ("csVerbosity", "verbosityL")] ''CommentSettings
data =
{ CommentHooks -> SequentialHooks
chFrontendHooks :: SequentialHooks
, CommentHooks -> GenCodeHooks
chBackendHooks :: GenCodeHooks
}
instance Semigroup CommentHooks where
CommentHooks f :: SequentialHooks
f b :: GenCodeHooks
b <> :: CommentHooks -> CommentHooks -> CommentHooks
<> CommentHooks f1 :: SequentialHooks
f1 b1 :: GenCodeHooks
b1 = SequentialHooks -> GenCodeHooks -> CommentHooks
CommentHooks (SequentialHooks
f SequentialHooks -> SequentialHooks -> SequentialHooks
forall a. Semigroup a => a -> a -> a
<> SequentialHooks
f1) (GenCodeHooks
b GenCodeHooks -> GenCodeHooks -> GenCodeHooks
forall a. Semigroup a => a -> a -> a
<> GenCodeHooks
b1)
instance Monoid CommentHooks where
mempty :: CommentHooks
mempty = SequentialHooks -> GenCodeHooks -> CommentHooks
CommentHooks SequentialHooks
forall a. Monoid a => a
mempty GenCodeHooks
forall a. Monoid a => a
mempty
makeLensesFor [ ("chFrontendHooks", "frontendHooksL")
, ("chBackendHooks", "backendHooksL")]
''CommentHooks
prettyFrontendCallStack :: Bool -> Bool -> (String, String) -> CallStack -> ([Text], Text)
prettyFrontendCallStack :: Bool -> Bool -> (String, String) -> CallStack -> ([Text], Text)
prettyFrontendCallStack printFullStk :: Bool
printFullStk fileName :: Bool
fileName (strt :: String
strt, ends :: String
ends) cs :: CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
(fn :: String
fn, loc :: SrcLoc
loc) : rest :: [(String, SrcLoc)]
rest ->
( (String, SrcLoc) -> Text
forall a. IsString a => (String, SrcLoc) -> a
prettyTop (String
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strt, SrcLoc
loc) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
if Bool
printFullStk Bool -> Bool -> Bool
&& Bool -> Bool
not ([(String, SrcLoc)] -> Bool
forall t. Container t => t -> Bool
null [(String, SrcLoc)]
rest) then
("Full stacktrace for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString String
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": ") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
(Int -> (String, SrcLoc) -> Text)
-> [Int] -> [(String, SrcLoc)] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i :: Int
i c :: (String, SrcLoc)
c -> String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indentSpaces) ' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String, SrcLoc) -> String
prettyCallSite (String, SrcLoc)
c)
[1..] [(String, SrcLoc)]
rest
else []
, (String, SrcLoc) -> Text
forall a. IsString a => (String, SrcLoc) -> a
prettyTop (String
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ends, SrcLoc
loc)
)
[] -> Text -> ([Text], Text)
forall a. HasCallStack => Text -> a
error "empty call stack in prettyFrontendCallStack"
where
prettyTop :: (String, SrcLoc) -> a
prettyTop (fn :: String
fn, loc :: SrcLoc
loc) = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ (String, SrcLoc) -> String
prettyCallSite (String
fn, SrcLoc
loc)
indentSpaces :: Int
indentSpaces = 2
prettyCallSite :: (String, SrcLoc) -> String
prettyCallSite (f :: String
f, loc :: SrcLoc
loc) = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (called at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
prettySrcLoc' SrcLoc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
prettySrcLoc' :: SrcLoc -> String
prettySrcLoc' :: SrcLoc -> String
prettySrcLoc' SrcLoc {..} = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
srcLocModule, ":", Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
srcLocStartLine, ":", Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
srcLocStartCol]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if Bool
fileName then [" in ", String
srcLocFile] else []
settingsToHooks :: CommentSettings -> CommentHooks
settingsToHooks :: CommentSettings -> CommentHooks
settingsToHooks (CommentSettings NoComments _ _) = CommentHooks
forall a. Monoid a => a
mempty
settingsToHooks c :: CommentSettings
c@(CommentSettings LogTopLevelFrontendStatements p :: Bool
p f :: Bool
f) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
NoComments)
CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
& (SequentialHooks -> Identity SequentialHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks SequentialHooks
frontendHooksL ((SequentialHooks -> Identity SequentialHooks)
-> CommentHooks -> Identity CommentHooks)
-> (((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> SequentialHooks -> Identity SequentialHooks)
-> ((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> CommentHooks
-> Identity CommentHooks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> SequentialHooks -> Identity SequentialHooks
Lens'
SequentialHooks (CallStack -> Block -> State InstrCollector ())
stmtHookL (((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> CommentHooks -> Identity CommentHooks)
-> (CallStack -> Block -> State InstrCollector ())
-> CommentHooks
-> CommentHooks
forall s t a b. ASetter s t a b -> b -> s -> t
.~ \cs :: CallStack
cs blk :: Block
blk -> do
let (stCallStk :: [Text]
stCallStk, en :: Text
en) = Bool -> Bool -> (String, String) -> CallStack -> ([Text], Text)
prettyFrontendCallStack Bool
p Bool
f ("[fr-stmt starts]", "[fr-stmt ends]") CallStack
cs
(InstrCollector -> InstrCollector) -> State InstrCollector ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InstrCollector -> InstrCollector) -> State InstrCollector ())
-> (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ \iColl :: InstrCollector
iColl -> InstrCollector
iColl {instrList :: Block
instrList = Text -> Instruction
Comment Text
en Instruction -> Block -> Block
forall a. a -> [a] -> [a]
: Block -> Block
forall a. [a] -> [a]
reverse Block
blk Block -> Block -> Block
forall a. [a] -> [a] -> [a]
++ (Text -> Instruction) -> [Text] -> Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Instruction
Comment ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
stCallStk) Block -> Block -> Block
forall a. [a] -> [a] -> [a]
++ InstrCollector -> Block
instrList InstrCollector
iColl}
settingsToHooks c :: CommentSettings
c@(CommentSettings LogBackendStatements _ _) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
LogTopLevelFrontendStatements) CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
&
(GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks GenCodeHooks
backendHooksL ((GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks)
-> (GenCodeHooks -> GenCodeHooks) -> CommentHooks -> CommentHooks
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \bh :: GenCodeHooks
bh -> GenCodeHooks
bh
{gchStmtHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchStmtHook = \t :: Text
t cd :: inp :-> out
cd ->
CommentType -> inp :-> inp
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " [bk-stmt starts]") (inp :-> inp) -> (inp :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
inp :-> out
cd (inp :-> out) -> (out :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
CommentType -> out :-> out
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " [bk-stmt ends]")
}
settingsToHooks c :: CommentSettings
c@(CommentSettings LogAuxCode _ _) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
LogBackendStatements) CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
&
(GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks GenCodeHooks
backendHooksL ((GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks)
-> (GenCodeHooks -> GenCodeHooks) -> CommentHooks -> CommentHooks
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \bh :: GenCodeHooks
bh -> GenCodeHooks
bh
{ gchAuxiliaryHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchAuxiliaryHook = \t :: Text
t cd :: inp :-> out
cd ->
let commInstr :: inp :-> inp
commInstr = CommentType -> inp :-> inp
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " [bk-aux starts]") in
let resLorBlock :: Instr (ToTs inp) (ToTs out)
resLorBlock = (inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz inp :-> out
cd in
if (Instr (ToTs inp) (ToTs out) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
M.instrToOps Instr (ToTs inp) (ToTs out)
resLorBlock [ExpandedOp] -> [ExpandedOp] -> Bool
forall a. Eq a => a -> a -> Bool
== Instr Any Any -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
M.instrToOps Instr Any Any
forall (inp :: [T]). Instr inp inp
M.Nop)
then inp :-> out
cd
else inp :-> inp
commInstr (inp :-> inp) -> (inp :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# inp :-> out
cd
}
settingsToHooks c :: CommentSettings
c@(CommentSettings LogExpressionsComputations _ _) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
LogAuxCode) CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
&
(GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks GenCodeHooks
backendHooksL ((GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks)
-> (GenCodeHooks -> GenCodeHooks) -> CommentHooks -> CommentHooks
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \bh :: GenCodeHooks
bh -> GenCodeHooks
bh
{ gchExprHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchExprHook = \expr :: Text
expr cd :: inp :-> out
cd ->
CommentType -> inp :-> inp
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
expr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " [bk-expr starts]") (inp :-> inp) -> (inp :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
inp :-> out
cd (inp :-> out) -> (out :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
CommentType -> out :-> out
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
expr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " [bk-expr ends]")
}