{-# 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