module HIndent
(
reformat
,prettyPrint
,parseMode
,styles
,chrisDone
,michaelSnoyman
,johanTibell
,fundamental
,test)
where
import Data.Function
import HIndent.Pretty
import HIndent.Styles.ChrisDone
import HIndent.Styles.Fundamental
import HIndent.Styles.JohanTibell
import HIndent.Styles.MichaelSnoyman
import HIndent.Types
import Control.Monad.State
import Data.Data
import Data.Monoid
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as T
import qualified Data.Text.Lazy.IO as T
import Data.Traversable
import Language.Haskell.Exts.Annotated hiding (Style,prettyPrint,Pretty,style,parse)
reformat :: Config -> Style -> Text -> Either String Builder
reformat config style x =
case parseDeclWithComments parseMode
(T.unpack x) of
ParseOk (v,comments) ->
case annotateComments v comments of
(cs,ast) ->
Right (prettyPrint config style (do mapM_ printComment cs
pretty ast))
ParseFailed _ e -> Left e
prettyPrint :: Config -> Style -> Printer () -> Builder
prettyPrint config style m =
psOutput (execState (runPrinter m)
(case style of
Style _name _author _desc st extenders _defconfig ->
PrintState 0 mempty False 0 1 st extenders config False))
parseMode :: ParseMode
parseMode =
defaultParseMode {extensions = allExtensions
,fixities = Nothing}
where allExtensions =
filter isDisabledExtention knownExtensions
isDisabledExtention (DisableExtension _) = False
isDisabledExtention _ = True
test :: Config -> Style -> Text -> IO ()
test config style =
either error (T.putStrLn . T.toLazyText) .
reformat config style
styles :: [Style]
styles =
[fundamental,chrisDone,michaelSnoyman,johanTibell]
annotateComments :: (Data (ast NodeInfo),Traversable ast,Annotated ast) => ast SrcSpanInfo -> [Comment] -> ([Comment],ast NodeInfo)
annotateComments =
foldr (\c (cs,ast) ->
case execState (traverse (collect c) ast) Nothing of
Nothing -> (c : cs,ast)
Just l ->
(cs,evalState (traverse (insert l c) ast) False)) .
([],) .
fmap (\n -> NodeInfo n [])
where collect c ni@(NodeInfo l _) =
do when (commentAfter c ni)
(modify (\ml ->
maybe (Just l)
(\l' ->
Just (if on spanBefore srcInfoSpan l l'
then l'
else l))
ml))
return ni
insert al c ni@(NodeInfo bl cs) =
do done <- get
if not done && al == bl
then do put True
return (ni {nodeInfoComments = c : cs})
else return ni
commentAfter :: Comment -> NodeInfo -> Bool
commentAfter (Comment _ cspan _) (NodeInfo (SrcSpanInfo nspan _) _) =
spanBefore nspan cspan
spanBefore :: SrcSpan -> SrcSpan -> Bool
spanBefore a b =
(srcSpanEndLine a < srcSpanEndLine b) ||
((srcSpanEndLine a == srcSpanEndLine b) &&
(srcSpanEndColumn a < srcSpanEndColumn b))