{-|
Description : Exact syntax tree as parsed and printed by HSE
-}
module Language.Haskell.Formatter.ExactCode
       (ExactCode, actualCode, comments, create) where
import qualified Language.Haskell.Formatter.Location as Location
import qualified Language.Haskell.Formatter.Source as Source

data ExactCode = ExactCode{ExactCode -> Module SrcSpanInfo
actualCode :: Source.Module Location.SrcSpanInfo,
                           ExactCode -> [Comment]
comments :: [Source.Comment]}

instance Show ExactCode where
        show :: ExactCode -> String
show ExactCode
exact = Module SrcSpanInfo -> [Comment] -> String
forall (ast :: * -> *).
ExactP ast =>
ast SrcSpanInfo -> [Comment] -> String
Source.exactPrint Module SrcSpanInfo
rawActualCode [Comment]
rawComments
          where rawActualCode :: Module SrcSpanInfo
rawActualCode = ExactCode -> Module SrcSpanInfo
actualCode ExactCode
exact
                rawComments :: [Comment]
rawComments = ExactCode -> [Comment]
comments ExactCode
exact

instance Location.Portioned ExactCode where
        getPortion :: ExactCode -> SrcSpan
getPortion = Module SrcSpanInfo -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion (Module SrcSpanInfo -> SrcSpan)
-> (ExactCode -> Module SrcSpanInfo) -> ExactCode -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExactCode -> Module SrcSpanInfo
actualCode

create :: Source.Module Location.SrcSpanInfo -> [Source.Comment] -> ExactCode
create :: Module SrcSpanInfo -> [Comment] -> ExactCode
create Module SrcSpanInfo
rawActualCode [Comment]
rawComments
  = ExactCode :: Module SrcSpanInfo -> [Comment] -> ExactCode
ExactCode{actualCode :: Module SrcSpanInfo
actualCode = Module SrcSpanInfo
rawActualCode, comments :: [Comment]
comments = [Comment]
rawComments}