{-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Declaration.Signature.Inline.Phase ( InlinePhase , mkInlinePhase ) where import qualified GHC.Types.Basic as GHC import HIndent.Ast.NodeComments import {-# SOURCE #-} HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments data BeforeOrAfter = Before | After data InlinePhase = InlinePhase { InlinePhase -> BeforeOrAfter beforeOrAfter :: BeforeOrAfter , InlinePhase -> Int phase :: Int } instance CommentExtraction InlinePhase where nodeComments :: InlinePhase -> NodeComments nodeComments InlinePhase {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty InlinePhase where pretty' :: InlinePhase -> Printer () pretty' InlinePhase {beforeOrAfter :: InlinePhase -> BeforeOrAfter beforeOrAfter = BeforeOrAfter Before, Int phase :: InlinePhase -> Int phase :: Int ..} = Printer () -> Printer () forall a. Printer a -> Printer a brackets (HasCallStack => String -> Printer () String -> Printer () string (String -> Printer ()) -> String -> Printer () forall a b. (a -> b) -> a -> b $ Char '~' Char -> String -> String forall a. a -> [a] -> [a] : Int -> String forall a. Show a => a -> String show Int phase) pretty' InlinePhase {beforeOrAfter :: InlinePhase -> BeforeOrAfter beforeOrAfter = BeforeOrAfter After, Int phase :: InlinePhase -> Int phase :: Int ..} = Printer () -> Printer () forall a. Printer a -> Printer a brackets (HasCallStack => String -> Printer () String -> Printer () string (String -> Printer ()) -> String -> Printer () forall a b. (a -> b) -> a -> b $ Int -> String forall a. Show a => a -> String show Int phase) mkInlinePhase :: GHC.Activation -> Maybe InlinePhase mkInlinePhase :: Activation -> Maybe InlinePhase mkInlinePhase (GHC.ActiveBefore SourceText _ Int phase) = InlinePhase -> Maybe InlinePhase forall a. a -> Maybe a Just (InlinePhase -> Maybe InlinePhase) -> InlinePhase -> Maybe InlinePhase forall a b. (a -> b) -> a -> b $ BeforeOrAfter -> Int -> InlinePhase InlinePhase BeforeOrAfter Before Int phase mkInlinePhase (GHC.ActiveAfter SourceText _ Int phase) = InlinePhase -> Maybe InlinePhase forall a. a -> Maybe a Just (InlinePhase -> Maybe InlinePhase) -> InlinePhase -> Maybe InlinePhase forall a b. (a -> b) -> a -> b $ BeforeOrAfter -> Int -> InlinePhase InlinePhase BeforeOrAfter After Int phase mkInlinePhase Activation _ = Maybe InlinePhase forall a. Maybe a Nothing