{-|
Description : Rearranging the actual code (not the comments)
-}
module Language.Haskell.Formatter.Process.FormatActualCode (formatActualCode)
       where
import qualified Control.Applicative as Applicative
import qualified Language.Haskell.Formatter.Process.Code as Code
import qualified Language.Haskell.Formatter.Process.CodeOrdering as CodeOrdering
import qualified Language.Haskell.Formatter.Result as Result
import qualified Language.Haskell.Formatter.Source as Source
import qualified Language.Haskell.Formatter.Style as Style
import qualified Language.Haskell.Formatter.Toolkit.Visit as Visit

formatActualCode ::
                 Style.Style ->
                   Code.LocatableCommentableCode ->
                     Result.Result Code.LocatableCommentableCode
formatActualCode :: Style
-> LocatableCommentableCode -> Result LocatableCommentableCode
formatActualCode Style
style LocatableCommentableCode
locatableCommentable
  = do LocatableCode
locatable <- Style -> LocatableCommentableCode -> Result LocatableCode
prettyPrint Style
style LocatableCommentableCode
locatableCommentable'
       LocatableCode -> CommentableCode -> Result LocatableCommentableCode
Code.tryZipLocationsComments LocatableCode
locatable CommentableCode
commentable
  where locatableCommentable' :: LocatableCommentableCode
locatableCommentable' = Style -> LocatableCommentableCode -> LocatableCommentableCode
prepare Style
style LocatableCommentableCode
locatableCommentable
        commentable :: CommentableCode
commentable = LocatableCommentableCode -> CommentableCode
Code.dropLocations LocatableCommentableCode
locatableCommentable'

prettyPrint ::
            Style.Style ->
              Code.LocatableCommentableCode -> Result.Result Code.LocatableCode
prettyPrint :: Style -> LocatableCommentableCode -> Result LocatableCode
prettyPrint Style
style LocatableCommentableCode
locatableCommentable
  = case ParseResult LocatableCode
parseResult of
        Source.ParseFailed SrcLoc
_ String
_ -> String -> Result LocatableCode
forall a. String -> Result a
Result.fatalAssertionError String
message
          where message :: String
message = String
"Formatting the actual code failed to parse."
        Source.ParseOk LocatableCode
possiblyChanged -> Maybe LocatableCode -> Result LocatableCode
forall a. Maybe a -> Result a
tryUnwrap Maybe LocatableCode
maybeLocatable'
          where maybeLocatable' :: Maybe LocatableCode
maybeLocatable'
                  = (SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo)
-> LocatableCode -> LocatableCode -> Maybe LocatableCode
forall (t :: * -> *) (f :: * -> *) a b c.
(Traversable t, Foldable f) =>
(a -> b -> c) -> t a -> f b -> Maybe (t c)
Visit.halfZipWith ((SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo)
-> SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo
forall a b. a -> b -> a
const) LocatableCode
locatable LocatableCode
possiblyChanged
  where parseResult :: ParseResult LocatableCode
parseResult
          = String -> ParseResult LocatableCode
Source.parseFileContents (String -> ParseResult LocatableCode)
-> String -> ParseResult LocatableCode
forall a b. (a -> b) -> a -> b
$ Style -> LocatableCode -> String
forall a. Pretty a => Style -> a -> String
defaultPrettyPrint Style
style LocatableCode
locatable
        locatable :: LocatableCode
locatable = LocatableCommentableCode -> LocatableCode
Code.dropComments LocatableCommentableCode
locatableCommentable
        tryUnwrap :: Maybe a -> Result a
tryUnwrap Maybe a
maybeLocatable'
          = case Maybe a
maybeLocatable' of
                Maybe a
Nothing -> String -> Result a
forall a. String -> Result a
Result.fatalAssertionError String
message
                  where message :: String
message = String
"Formatting the actual code failed to zip."
                Just a
locatable' -> a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
locatable'

defaultPrettyPrint :: Source.Pretty a => Style.Style -> a -> String
defaultPrettyPrint :: Style -> a -> String
defaultPrettyPrint
  = (Style -> PPHsMode -> a -> String)
-> (Style -> Style) -> (Style -> PPHsMode) -> Style -> a -> String
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 Style -> PPHsMode -> a -> String
forall a. Pretty a => Style -> PPHsMode -> a -> String
Source.prettyPrintStyleMode Style -> Style
renderingStyle Style -> PPHsMode
mode

renderingStyle :: Style.Style -> Source.Style
renderingStyle :: Style -> Style
renderingStyle Style
style
  = Style
Source.style{lineLength :: Int
Source.lineLength = Style -> Int
Style.lineLengthLimit Style
style,
                 ribbonsPerLine :: Float
Source.ribbonsPerLine = Style -> Float
Style.ribbonsPerLine Style
style}

mode :: Style.Style -> Source.PPHsMode
mode :: Style -> PPHsMode
mode Style
style
  = PPHsMode
Source.defaultMode{classIndent :: Int
Source.classIndent = Style -> Int
Style.classIndentation Style
style,
                       doIndent :: Int
Source.doIndent = Style -> Int
Style.doIndentation Style
style,
                       caseIndent :: Int
Source.caseIndent = Style -> Int
Style.caseIndentation Style
style,
                       letIndent :: Int
Source.letIndent = Style -> Int
Style.letIndentation Style
style,
                       whereIndent :: Int
Source.whereIndent = Style -> Int
Style.whereIndentation Style
style,
                       onsideIndent :: Int
Source.onsideIndent = Style -> Int
Style.onsideIndentation Style
style}

prepare ::
        Style.Style ->
          Code.LocatableCommentableCode -> Code.LocatableCommentableCode
prepare :: Style -> LocatableCommentableCode -> LocatableCommentableCode
prepare Style
style = [LocatableCommentableCode -> LocatableCommentableCode]
-> LocatableCommentableCode -> LocatableCommentableCode
forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
Visit.compose [LocatableCommentableCode -> LocatableCommentableCode]
preparations
  where preparations :: [LocatableCommentableCode -> LocatableCommentableCode]
preparations
          = [LocatableCommentableCode -> LocatableCommentableCode
preparation | (Style -> Bool
isApplied, LocatableCommentableCode -> LocatableCommentableCode
preparation) <- [(Style -> Bool,
  LocatableCommentableCode -> LocatableCommentableCode)]
applications,
             Style -> Bool
isApplied Style
style]
        applications :: [(Style -> Bool,
  LocatableCommentableCode -> LocatableCommentableCode)]
applications
          = [(Style -> Bool
Style.orderImportDeclarations,
              LocatableCommentableCode -> LocatableCommentableCode
CodeOrdering.orderImportDeclarations),
             (Style -> Bool
Style.orderImportEntities, LocatableCommentableCode -> LocatableCommentableCode
orderImportEntities)]

orderImportEntities ::
                    Code.LocatableCommentableCode ->
                      Code.LocatableCommentableCode
orderImportEntities :: LocatableCommentableCode -> LocatableCommentableCode
orderImportEntities
  = LocatableCommentableCode -> LocatableCommentableCode
CodeOrdering.orderRootImportEntities (LocatableCommentableCode -> LocatableCommentableCode)
-> (LocatableCommentableCode -> LocatableCommentableCode)
-> LocatableCommentableCode
-> LocatableCommentableCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      LocatableCommentableCode -> LocatableCommentableCode
CodeOrdering.orderNestedImportEntities