module HIndent.Types
(Printer(..)
,PrintState(..)
,Config(..)
,defaultConfig
,NodeInfo(..)
,NodeComment(..)
,SomeComment(..)
) where
import Control.Applicative
import Control.Monad
import Control.Monad.State.Strict (MonadState(..),StateT)
import Control.Monad.Trans.Maybe
import Data.ByteString.Builder
import Data.Functor.Identity
import Data.Int (Int64)
import Data.Maybe
import Data.Yaml (FromJSON(..))
import qualified Data.Yaml as Y
import Language.Haskell.Exts.SrcLoc
newtype Printer a =
Printer {runPrinter :: StateT PrintState (MaybeT Identity) a}
deriving (Applicative,Monad,Functor,MonadState PrintState,MonadPlus,Alternative)
data PrintState = PrintState
{ psIndentLevel :: !Int64
, psOutput :: !Builder
, psNewline :: !Bool
, psColumn :: !Int64
, psLine :: !Int64
, psConfig :: !Config
, psInsideCase :: !Bool
, psHardLimit :: !Bool
, psEolComment :: !Bool
}
data Config = Config
{ configMaxColumns :: !Int64
, configIndentSpaces :: !Int64
, configTrailingNewline :: !Bool
, configSortImports :: !Bool
, configLineBreaks :: [String]
}
instance FromJSON Config where
parseJSON (Y.Object v) =
Config <$>
fmap
(fromMaybe (configMaxColumns defaultConfig))
(v Y..:? "line-length") <*>
fmap
(fromMaybe (configIndentSpaces defaultConfig))
(v Y..:? "indent-size" <|> v Y..:? "tab-size") <*>
fmap
(fromMaybe (configTrailingNewline defaultConfig))
(v Y..:? "force-trailing-newline") <*>
fmap
(fromMaybe (configSortImports defaultConfig))
(v Y..:? "sort-imports") <*>
fmap
(fromMaybe (configLineBreaks defaultConfig))
(v Y..:? "line-breaks")
parseJSON _ = fail "Expected Object for Config value"
defaultConfig :: Config
defaultConfig =
Config
{ configMaxColumns = 80
, configIndentSpaces = 2
, configTrailingNewline = True
, configSortImports = True
, configLineBreaks = []
}
data SomeComment
= EndOfLine String
| MultiLine String
deriving (Show, Ord, Eq)
data NodeComment
= CommentSameLine SrcSpan SomeComment
| CommentAfterLine SrcSpan SomeComment
| CommentBeforeLine SrcSpan SomeComment
deriving (Show, Ord, Eq)
data NodeInfo = NodeInfo
{ nodeInfoSpan :: !SrcSpanInfo
, nodeInfoComments :: ![NodeComment]
}
instance Show NodeInfo where
show (NodeInfo _ []) = ""
show (NodeInfo _ s) =
"{- " ++ show s ++ " -}"