{-# 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 ( OutputRestriction -> OutputRestriction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputRestriction -> OutputRestriction -> Bool
$c/= :: OutputRestriction -> OutputRestriction -> Bool
== :: OutputRestriction -> OutputRestriction -> Bool
$c== :: OutputRestriction -> OutputRestriction -> Bool
Eq, Eq OutputRestriction
OutputRestriction -> OutputRestriction -> Bool
OutputRestriction -> OutputRestriction -> Ordering
OutputRestriction -> OutputRestriction -> OutputRestriction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputRestriction -> OutputRestriction -> OutputRestriction
$cmin :: OutputRestriction -> OutputRestriction -> OutputRestriction
max :: OutputRestriction -> OutputRestriction -> OutputRestriction
$cmax :: OutputRestriction -> OutputRestriction -> OutputRestriction
>= :: OutputRestriction -> OutputRestriction -> Bool
$c>= :: OutputRestriction -> OutputRestriction -> Bool
> :: OutputRestriction -> OutputRestriction -> Bool
$c> :: OutputRestriction -> OutputRestriction -> Bool
<= :: OutputRestriction -> OutputRestriction -> Bool
$c<= :: OutputRestriction -> OutputRestriction -> Bool
< :: OutputRestriction -> OutputRestriction -> Bool
$c< :: OutputRestriction -> OutputRestriction -> Bool
compare :: OutputRestriction -> OutputRestriction -> Ordering
$ccompare :: OutputRestriction -> OutputRestriction -> Ordering
Ord, Int -> OutputRestriction -> ShowS
[OutputRestriction] -> ShowS
OutputRestriction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputRestriction] -> ShowS
$cshowList :: [OutputRestriction] -> ShowS
show :: OutputRestriction -> String
$cshow :: OutputRestriction -> String
showsPrec :: Int -> OutputRestriction -> ShowS
$cshowsPrec :: Int -> OutputRestriction -> ShowS
Show )

data TypeLayout = TypeFree | TypeFlex | TypeVertical
    deriving ( TypeLayout -> TypeLayout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeLayout -> TypeLayout -> Bool
$c/= :: TypeLayout -> TypeLayout -> Bool
== :: TypeLayout -> TypeLayout -> Bool
$c== :: TypeLayout -> TypeLayout -> Bool
Eq, Eq TypeLayout
TypeLayout -> TypeLayout -> Bool
TypeLayout -> TypeLayout -> Ordering
TypeLayout -> TypeLayout -> TypeLayout
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeLayout -> TypeLayout -> TypeLayout
$cmin :: TypeLayout -> TypeLayout -> TypeLayout
max :: TypeLayout -> TypeLayout -> TypeLayout
$cmax :: TypeLayout -> TypeLayout -> TypeLayout
>= :: TypeLayout -> TypeLayout -> Bool
$c>= :: TypeLayout -> TypeLayout -> Bool
> :: TypeLayout -> TypeLayout -> Bool
$c> :: TypeLayout -> TypeLayout -> Bool
<= :: TypeLayout -> TypeLayout -> Bool
$c<= :: TypeLayout -> TypeLayout -> Bool
< :: TypeLayout -> TypeLayout -> Bool
$c< :: TypeLayout -> TypeLayout -> Bool
compare :: TypeLayout -> TypeLayout -> Ordering
$ccompare :: TypeLayout -> TypeLayout -> Ordering
Ord, Int -> TypeLayout -> ShowS
[TypeLayout] -> ShowS
TypeLayout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeLayout] -> ShowS
$cshowList :: [TypeLayout] -> ShowS
show :: TypeLayout -> String
$cshow :: TypeLayout -> String
showsPrec :: Int -> TypeLayout -> ShowS
$cshowsPrec :: Int -> TypeLayout -> ShowS
Show )

newtype Penalty = Penalty Int
    deriving ( Penalty -> Penalty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Penalty -> Penalty -> Bool
$c/= :: Penalty -> Penalty -> Bool
== :: Penalty -> Penalty -> Bool
$c== :: Penalty -> Penalty -> Bool
Eq, Eq Penalty
Penalty -> Penalty -> Bool
Penalty -> Penalty -> Ordering
Penalty -> Penalty -> Penalty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Penalty -> Penalty -> Penalty
$cmin :: Penalty -> Penalty -> Penalty
max :: Penalty -> Penalty -> Penalty
$cmax :: Penalty -> Penalty -> Penalty
>= :: Penalty -> Penalty -> Bool
$c>= :: Penalty -> Penalty -> Bool
> :: Penalty -> Penalty -> Bool
$c> :: Penalty -> Penalty -> Bool
<= :: Penalty -> Penalty -> Bool
$c<= :: Penalty -> Penalty -> Bool
< :: Penalty -> Penalty -> Bool
$c< :: Penalty -> Penalty -> Bool
compare :: Penalty -> Penalty -> Ordering
$ccompare :: Penalty -> Penalty -> Ordering
Ord, Integer -> Penalty
Penalty -> Penalty
Penalty -> Penalty -> Penalty
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Penalty
$cfromInteger :: Integer -> Penalty
signum :: Penalty -> Penalty
$csignum :: Penalty -> Penalty
abs :: Penalty -> Penalty
$cabs :: Penalty -> Penalty
negate :: Penalty -> Penalty
$cnegate :: Penalty -> Penalty
* :: Penalty -> Penalty -> Penalty
$c* :: Penalty -> Penalty -> Penalty
- :: Penalty -> Penalty -> Penalty
$c- :: Penalty -> Penalty -> Penalty
+ :: Penalty -> Penalty -> Penalty
$c+ :: Penalty -> Penalty -> Penalty
Num, Int -> Penalty -> ShowS
[Penalty] -> ShowS
Penalty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Penalty] -> ShowS
$cshowList :: [Penalty] -> ShowS
show :: Penalty -> String
$cshow :: Penalty -> String
showsPrec :: Int -> Penalty -> ShowS
$cshowsPrec :: Int -> Penalty -> ShowS
Show )

newtype TabStop = TabStop String
    deriving ( TabStop -> TabStop -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TabStop -> TabStop -> Bool
$c/= :: TabStop -> TabStop -> Bool
== :: TabStop -> TabStop -> Bool
$c== :: TabStop -> TabStop -> Bool
Eq, Eq TabStop
TabStop -> TabStop -> Bool
TabStop -> TabStop -> Ordering
TabStop -> TabStop -> TabStop
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TabStop -> TabStop -> TabStop
$cmin :: TabStop -> TabStop -> TabStop
max :: TabStop -> TabStop -> TabStop
$cmax :: TabStop -> TabStop -> TabStop
>= :: TabStop -> TabStop -> Bool
$c>= :: TabStop -> TabStop -> Bool
> :: TabStop -> TabStop -> Bool
$c> :: TabStop -> TabStop -> Bool
<= :: TabStop -> TabStop -> Bool
$c<= :: TabStop -> TabStop -> Bool
< :: TabStop -> TabStop -> Bool
$c< :: TabStop -> TabStop -> Bool
compare :: TabStop -> TabStop -> Ordering
$ccompare :: TabStop -> TabStop -> Ordering
Ord, Int -> TabStop -> ShowS
[TabStop] -> ShowS
TabStop -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TabStop] -> ShowS
$cshowList :: [TabStop] -> ShowS
show :: TabStop -> String
$cshow :: TabStop -> String
showsPrec :: Int -> TabStop -> ShowS
$cshowsPrec :: Int -> TabStop -> ShowS
Show )

instance Sem.Semigroup Penalty where
    <> :: Penalty -> Penalty -> Penalty
(<>) = forall a. Num a => a -> a -> a
(+)

instance Monoid Penalty where
    mempty :: Penalty
mempty = Penalty
0

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

-- | A pretty printing monad.
newtype Printer a =
    Printer { forall a. Printer a -> StateT PrintState (Search Penalty) a
unPrinter :: StateT PrintState (Search Penalty) a }
    deriving ( Functor Printer
forall a. a -> Printer a
forall a b. Printer a -> Printer b -> Printer a
forall a b. Printer a -> Printer b -> Printer b
forall a b. Printer (a -> b) -> Printer a -> Printer b
forall a b c. (a -> b -> c) -> Printer a -> Printer b -> Printer c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Printer a -> Printer b -> Printer a
$c<* :: forall a b. Printer a -> Printer b -> Printer a
*> :: forall a b. Printer a -> Printer b -> Printer b
$c*> :: forall a b. Printer a -> Printer b -> Printer b
liftA2 :: forall a b c. (a -> b -> c) -> Printer a -> Printer b -> Printer c
$cliftA2 :: forall a b c. (a -> b -> c) -> Printer a -> Printer b -> Printer c
<*> :: forall a b. Printer (a -> b) -> Printer a -> Printer b
$c<*> :: forall a b. Printer (a -> b) -> Printer a -> Printer b
pure :: forall a. a -> Printer a
$cpure :: forall a. a -> Printer a
Applicative, Applicative Printer
forall a. a -> Printer a
forall a b. Printer a -> Printer b -> Printer b
forall a b. Printer a -> (a -> Printer b) -> Printer b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Printer a
$creturn :: forall a. a -> Printer a
>> :: forall a b. Printer a -> Printer b -> Printer b
$c>> :: forall a b. Printer a -> Printer b -> Printer b
>>= :: forall a b. Printer a -> (a -> Printer b) -> Printer b
$c>>= :: forall a b. Printer a -> (a -> Printer b) -> Printer b
Monad, forall a b. a -> Printer b -> Printer a
forall a b. (a -> b) -> Printer a -> Printer b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Printer b -> Printer a
$c<$ :: forall a b. a -> Printer b -> Printer a
fmap :: forall a b. (a -> b) -> Printer a -> Printer b
$cfmap :: forall a b. (a -> b) -> Printer a -> Printer b
Functor, MonadState PrintState
             , MonadSearch Penalty, Monad Printer
Alternative Printer
forall a. Printer a
forall a. Printer a -> Printer a -> Printer a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Printer a -> Printer a -> Printer a
$cmplus :: forall a. Printer a -> Printer a -> Printer a
mzero :: forall a. Printer a
$cmzero :: forall a. Printer a
MonadPlus, Applicative Printer
forall a. Printer a
forall a. Printer a -> Printer [a]
forall a. Printer a -> Printer a -> Printer a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Printer a -> Printer [a]
$cmany :: forall a. Printer a -> Printer [a]
some :: forall a. Printer a -> Printer [a]
$csome :: forall a. Printer a -> Printer [a]
<|> :: forall a. Printer a -> Printer a -> Printer a
$c<|> :: forall a. Printer a -> Printer a -> Printer a
empty :: forall a. Printer a
$cempty :: forall a. Printer a
Alternative )

execPrinter :: Printer a -> PrintState -> Maybe (Penalty, PrintState)
execPrinter :: forall a. Printer a -> PrintState -> Maybe (Penalty, PrintState)
execPrinter Printer a
m PrintState
s = forall c a. (Ord c, Monoid c) => Search c a -> Maybe (c, a)
runSearchBest forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (forall a. Printer a -> StateT PrintState (Search Penalty) a
unPrinter Printer a
m) PrintState
s

runPrinter :: Printer a -> PrintState -> Maybe (Penalty, (a, PrintState))
runPrinter :: forall a.
Printer a -> PrintState -> Maybe (Penalty, (a, PrintState))
runPrinter Printer a
m PrintState
s = forall c a. (Ord c, Monoid c) => Search c a -> Maybe (c, a)
runSearchBest forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall a. Printer a -> StateT PrintState (Search Penalty) a
unPrinter Printer a
m) PrintState
s

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

psLine :: PrintState -> Int
psLine :: PrintState -> Int
psLine = Buffer -> Int
Buffer.line forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Buffer
psBuffer

psColumn :: PrintState -> Int
psColumn :: PrintState -> Int
psColumn = Buffer -> Int
Buffer.column forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Buffer
psBuffer

psNewline :: PrintState -> Bool
psNewline :: PrintState -> Bool
psNewline = (forall a. Eq a => a -> a -> Bool
== Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
Buffer.column forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Buffer
psBuffer

initialPrintState :: Config -> PrintState
initialPrintState :: Config -> PrintState
initialPrintState Config
config =
    Buffer
-> Int
-> Int
-> Map TabStop Int
-> Config
-> Bool
-> OutputRestriction
-> TypeLayout
-> PrintState
PrintState Buffer
Buffer.empty Int
0 Int
0 forall k a. Map k a
Map.empty Config
config Bool
False OutputRestriction
Anything TypeLayout
TypeFree

data CommentType =
    InlineComment | LineComment | PreprocessorDirective | IgnoredLine
    deriving ( Int -> CommentType -> ShowS
[CommentType] -> ShowS
CommentType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentType] -> ShowS
$cshowList :: [CommentType] -> ShowS
show :: CommentType -> String
$cshow :: CommentType -> String
showsPrec :: Int -> CommentType -> ShowS
$cshowsPrec :: Int -> CommentType -> ShowS
Show )

data Comment = Comment { Comment -> CommentType
commentType :: !CommentType
                       , Comment -> SrcSpan
commentSpan :: !SrcSpan
                       , Comment -> String
commentText :: !String
                       }
    deriving ( Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show )

-- | Information for each node in the AST.
data NodeInfo =
    NodeInfo { NodeInfo -> SrcSpan
nodeInfoSpan             :: !SrcSpan               -- ^ Location info from the parser.
             , NodeInfo -> [Comment]
nodeInfoLeadingComments  :: ![Comment]  -- ^ Leading comments attached to this node.
             , NodeInfo -> [Comment]
nodeInfoTrailingComments :: ![Comment] -- ^ Trailing comments attached to this node.
             }
    deriving ( Int -> NodeInfo -> ShowS
[NodeInfo] -> ShowS
NodeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeInfo] -> ShowS
$cshowList :: [NodeInfo] -> ShowS
show :: NodeInfo -> String
$cshow :: NodeInfo -> String
showsPrec :: Int -> NodeInfo -> ShowS
$cshowsPrec :: Int -> NodeInfo -> ShowS
Show )

-- | Empty NodeInfo
noNodeInfo :: NodeInfo
noNodeInfo :: NodeInfo
noNodeInfo = SrcSpan -> [Comment] -> [Comment] -> NodeInfo
NodeInfo (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
noLoc SrcLoc
noLoc) [] []

nodeSpan :: Annotated ast => ast NodeInfo -> SrcSpan
nodeSpan :: forall (ast :: * -> *). Annotated ast => ast NodeInfo -> SrcSpan
nodeSpan = NodeInfo -> SrcSpan
nodeInfoSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann