{-|
Description : Facade for HSE without location handling

See also "Language.Haskell.Formatter.Location".
-}
module Language.Haskell.Formatter.Source
       (Comments.Comment, ExactPrint.exactPrint, Exts.parseFileContents,
        Exts.parseFileContentsWithComments, Parser.defaultParseMode,
        Parser.parseFilename, Parser.ParseResult(..),
        module Language.Haskell.Exts.Pretty, (Syntax.=~=), Syntax.Module,
        createComment, commentCore)
       where
import qualified Language.Haskell.Exts as Exts
import qualified Language.Haskell.Exts.Comments as Comments
import qualified Language.Haskell.Exts.ExactPrint as ExactPrint
import qualified Language.Haskell.Exts.Parser as Parser
import Language.Haskell.Exts.Pretty
import qualified Language.Haskell.Exts.Syntax as Syntax
import qualified Language.Haskell.Formatter.CommentCore as CommentCore
import qualified Language.Haskell.Formatter.Location as Location

createComment :: CommentCore.CommentCore -> Location.SrcSpan -> Comments.Comment
createComment :: CommentCore -> SrcSpan -> Comment
createComment CommentCore
core SrcSpan
portion = Bool -> SrcSpan -> String -> Comment
Comments.Comment Bool
isMultiLine SrcSpan
portion String
content
  where isMultiLine :: Bool
isMultiLine
          = case CommentCore -> Kind
CommentCore.kind CommentCore
core of
                Kind
CommentCore.Ordinary -> Bool
False
                Kind
CommentCore.Nested -> Bool
True
        content :: String
content = CommentCore -> String
CommentCore.content CommentCore
core

commentCore :: Comments.Comment -> CommentCore.CommentCore
commentCore :: Comment -> CommentCore
commentCore Comment
comment = Kind -> String -> CommentCore
CommentCore.create Kind
kind String
content
  where kind :: Kind
kind = Comment -> Kind
commentKind Comment
comment
        content :: String
content = Comment -> String
commentContent Comment
comment

commentKind :: Comments.Comment -> CommentCore.Kind
commentKind :: Comment -> Kind
commentKind (Comments.Comment Bool
False SrcSpan
_ String
_) = Kind
CommentCore.Ordinary
commentKind (Comments.Comment Bool
True SrcSpan
_ String
_) = Kind
CommentCore.Nested

commentContent :: Comments.Comment -> String
commentContent :: Comment -> String
commentContent (Comments.Comment Bool
_ SrcSpan
_ String
content) = String
content