{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | All types.
module Floskell.Types
    ( OutputRestriction(..)
    , TypeLayout(..)
    , Penalty(..)
    , TabStop(..)
    , Printer(..)
    , execPrinter
    , runPrinter
    , PrintState(..)
    , psLine
    , psColumn
    , psNewline
    , initialPrintState
    , Config(..)
    , SrcSpan(..)
    , CommentType(..)
    , Comment(..)
    , NodeInfo(..)
    , noNodeInfo
    , nodeSpan
    , Location(..)
    ) where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Search
                 ( MonadSearch, Search, runSearchBest )
import           Control.Monad.State.Strict
                 ( MonadState(..), StateT, execStateT, runStateT )

import qualified Data.Map.Strict              as Map
import           Data.Semigroup               as Sem

import           Floskell.Buffer              ( Buffer )
import qualified Floskell.Buffer              as Buffer
import           Floskell.Config              ( Config(..), Location(..) )

import           Language.Haskell.Exts.SrcLoc ( SrcSpan(..), mkSrcSpan, noLoc )
import           Language.Haskell.Exts.Syntax ( Annotated(..) )

data OutputRestriction = Anything | NoOverflow | NoOverflowOrLinebreak
    deriving ( Eq, Ord, Show )

data TypeLayout = TypeFree | TypeFlex | TypeVertical
    deriving ( Eq, Ord, Show )

newtype Penalty = Penalty Int
    deriving ( Eq, Ord, Num, Show )

newtype TabStop = TabStop String
    deriving ( Eq, Ord, Show )

instance Sem.Semigroup Penalty where
    (<>) = (+)

instance Monoid Penalty where
    mempty = 0

#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif

-- | A pretty printing monad.
newtype Printer a =
    Printer { unPrinter :: StateT PrintState (Search Penalty) a }
    deriving ( Applicative, Monad, Functor, MonadState PrintState
             , MonadSearch Penalty, MonadPlus, Alternative )

execPrinter :: Printer a -> PrintState -> Maybe (Penalty, PrintState)
execPrinter m s = runSearchBest $ execStateT (unPrinter m) s

runPrinter :: Printer a -> PrintState -> Maybe (Penalty, (a, PrintState))
runPrinter m s = runSearchBest $ runStateT (unPrinter m) s

-- | The state of the pretty printer.
data PrintState =
    PrintState { psBuffer :: !Buffer -- ^ Output buffer
               , psIndentLevel :: !Int -- ^ Current indentation level.
               , psOnside :: !Int -- ^ Extra indentation is necessary with next line break.
               , psTabStops :: !(Map.Map TabStop Int) -- ^ Tab stops for alignment.
               , psConfig :: !Config -- ^ Style definition.
               , psEolComment :: !Bool -- ^ An end of line comment has just been outputted.
               , psOutputRestriction :: !OutputRestriction
               , psTypeLayout :: !TypeLayout
               }

psLine :: PrintState -> Int
psLine = Buffer.line . psBuffer

psColumn :: PrintState -> Int
psColumn = Buffer.column . psBuffer

psNewline :: PrintState -> Bool
psNewline = (== 0) . Buffer.column . psBuffer

initialPrintState :: Config -> PrintState
initialPrintState config =
    PrintState Buffer.empty 0 0 Map.empty config False Anything TypeFree

data CommentType = InlineComment | LineComment | PreprocessorDirective
    deriving ( Show )

data Comment = Comment { commentType :: !CommentType
                       , commentSpan :: !SrcSpan
                       , commentText :: !String
                       }
    deriving ( Show )

-- | Information for each node in the AST.
data NodeInfo =
    NodeInfo { nodeInfoSpan :: !SrcSpan               -- ^ Location info from the parser.
             , nodeInfoLeadingComments :: ![Comment]  -- ^ Leading comments attached to this node.
             , nodeInfoTrailingComments :: ![Comment] -- ^ Trailing comments attached to this node.
             }
    deriving ( Show )

-- | Empty NodeInfo
noNodeInfo :: NodeInfo
noNodeInfo = NodeInfo (mkSrcSpan noLoc noLoc) [] []

nodeSpan :: Annotated ast => ast NodeInfo -> SrcSpan
nodeSpan = nodeInfoSpan . ann