{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
module HIndent.Types
(Printer(..)
,PrintState(..)
,Config(..)
,readExtension
,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 hiding (Style, prettyPrint, Pretty, style, parse)
newtype Printer a =
Printer {Printer a -> StateT PrintState (MaybeT Identity) a
runPrinter :: StateT PrintState (MaybeT Identity) a}
deriving (Functor Printer
a -> Printer a
Functor Printer
-> (forall a. a -> Printer a)
-> (forall a b. Printer (a -> b) -> Printer a -> Printer b)
-> (forall a b c.
(a -> b -> c) -> Printer a -> Printer b -> Printer c)
-> (forall a b. Printer a -> Printer b -> Printer b)
-> (forall a b. Printer a -> Printer b -> Printer a)
-> Applicative Printer
Printer a -> Printer b -> Printer b
Printer a -> Printer b -> Printer a
Printer (a -> b) -> Printer a -> Printer b
(a -> b -> c) -> Printer a -> Printer b -> Printer c
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
<* :: Printer a -> Printer b -> Printer a
$c<* :: forall a b. Printer a -> Printer b -> Printer a
*> :: Printer a -> Printer b -> Printer b
$c*> :: forall a b. Printer a -> Printer b -> Printer b
liftA2 :: (a -> b -> c) -> Printer a -> Printer b -> Printer c
$cliftA2 :: forall a b c. (a -> b -> c) -> Printer a -> Printer b -> Printer c
<*> :: Printer (a -> b) -> Printer a -> Printer b
$c<*> :: forall a b. Printer (a -> b) -> Printer a -> Printer b
pure :: a -> Printer a
$cpure :: forall a. a -> Printer a
$cp1Applicative :: Functor Printer
Applicative,Applicative Printer
a -> Printer a
Applicative Printer
-> (forall a b. Printer a -> (a -> Printer b) -> Printer b)
-> (forall a b. Printer a -> Printer b -> Printer b)
-> (forall a. a -> Printer a)
-> Monad Printer
Printer a -> (a -> Printer b) -> Printer b
Printer a -> Printer b -> Printer b
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 :: a -> Printer a
$creturn :: forall a. a -> Printer a
>> :: Printer a -> Printer b -> Printer b
$c>> :: forall a b. Printer a -> Printer b -> Printer b
>>= :: Printer a -> (a -> Printer b) -> Printer b
$c>>= :: forall a b. Printer a -> (a -> Printer b) -> Printer b
$cp1Monad :: Applicative Printer
Monad,a -> Printer b -> Printer a
(a -> b) -> Printer a -> Printer b
(forall a b. (a -> b) -> Printer a -> Printer b)
-> (forall a b. a -> Printer b -> Printer a) -> Functor Printer
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
<$ :: a -> Printer b -> Printer a
$c<$ :: forall a b. a -> Printer b -> Printer a
fmap :: (a -> b) -> Printer a -> Printer b
$cfmap :: forall a b. (a -> b) -> Printer a -> Printer b
Functor,MonadState PrintState,Monad Printer
Alternative Printer
Printer a
Alternative Printer
-> Monad Printer
-> (forall a. Printer a)
-> (forall a. Printer a -> Printer a -> Printer a)
-> MonadPlus Printer
Printer a -> Printer a -> Printer a
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 :: Printer a -> Printer a -> Printer a
$cmplus :: forall a. Printer a -> Printer a -> Printer a
mzero :: Printer a
$cmzero :: forall a. Printer a
$cp2MonadPlus :: Monad Printer
$cp1MonadPlus :: Alternative Printer
MonadPlus,Applicative Printer
Printer a
Applicative Printer
-> (forall a. Printer a)
-> (forall a. Printer a -> Printer a -> Printer a)
-> (forall a. Printer a -> Printer [a])
-> (forall a. Printer a -> Printer [a])
-> Alternative Printer
Printer a -> Printer a -> Printer a
Printer a -> Printer [a]
Printer a -> Printer [a]
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 :: Printer a -> Printer [a]
$cmany :: forall a. Printer a -> Printer [a]
some :: Printer a -> Printer [a]
$csome :: forall a. Printer a -> Printer [a]
<|> :: Printer a -> Printer a -> Printer a
$c<|> :: forall a. Printer a -> Printer a -> Printer a
empty :: Printer a
$cempty :: forall a. Printer a
$cp1Alternative :: Applicative Printer
Alternative)
data PrintState = PrintState
{ PrintState -> Int64
psIndentLevel :: !Int64
, PrintState -> Builder
psOutput :: !Builder
, PrintState -> Bool
psNewline :: !Bool
, PrintState -> Int64
psColumn :: !Int64
, PrintState -> Int64
psLine :: !Int64
, PrintState -> Config
psConfig :: !Config
, PrintState -> Bool
psInsideCase :: !Bool
, PrintState -> Bool
psFitOnOneLine :: !Bool
, :: !Bool
}
data Config = Config
{ Config -> Int64
configMaxColumns :: !Int64
, Config -> Int64
configIndentSpaces :: !Int64
, Config -> Bool
configTrailingNewline :: !Bool
, Config -> Bool
configSortImports :: !Bool
, Config -> [String]
configLineBreaks :: [String]
, Config -> [Extension]
configExtensions :: [Extension]
}
#if __GLASGOW_HASKELL__ >= 808
readExtension :: (Monad m, MonadFail m) => String -> m Extension
#else
readExtension :: Monad m => String -> m Extension
#endif
readExtension :: String -> m Extension
readExtension String
x =
case String -> Extension
classifyExtension String
x
of
UnknownExtension String
_ -> String -> m Extension
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown extension: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
Extension
x' -> Extension -> m Extension
forall (m :: * -> *) a. Monad m => a -> m a
return Extension
x'
instance FromJSON Config where
parseJSON :: Value -> Parser Config
parseJSON (Y.Object Object
v) =
Int64 -> Int64 -> Bool -> Bool -> [String] -> [Extension] -> Config
Config (Int64
-> Int64 -> Bool -> Bool -> [String] -> [Extension] -> Config)
-> Parser Int64
-> Parser
(Int64 -> Bool -> Bool -> [String] -> [Extension] -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Maybe Int64 -> Int64) -> Parser (Maybe Int64) -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe (Config -> Int64
configMaxColumns Config
defaultConfig))
(Object
v Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Y..:? Text
"line-length") Parser (Int64 -> Bool -> Bool -> [String] -> [Extension] -> Config)
-> Parser Int64
-> Parser (Bool -> Bool -> [String] -> [Extension] -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe Int64 -> Int64) -> Parser (Maybe Int64) -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe (Config -> Int64
configIndentSpaces Config
defaultConfig))
(Object
v Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Y..:? Text
"indent-size" Parser (Maybe Int64)
-> Parser (Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Y..:? Text
"tab-size") Parser (Bool -> Bool -> [String] -> [Extension] -> Config)
-> Parser Bool
-> Parser (Bool -> [String] -> [Extension] -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Config -> Bool
configTrailingNewline Config
defaultConfig))
(Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Y..:? Text
"force-trailing-newline") Parser (Bool -> [String] -> [Extension] -> Config)
-> Parser Bool -> Parser ([String] -> [Extension] -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Config -> Bool
configSortImports Config
defaultConfig))
(Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Y..:? Text
"sort-imports") Parser ([String] -> [Extension] -> Config)
-> Parser [String] -> Parser ([Extension] -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe [String] -> [String])
-> Parser (Maybe [String]) -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe (Config -> [String]
configLineBreaks Config
defaultConfig))
(Object
v Object -> Text -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Y..:? Text
"line-breaks") Parser ([Extension] -> Config)
-> Parser [Extension] -> Parser Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
((String -> Parser Extension) -> [String] -> Parser [Extension]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Parser Extension
forall (m :: * -> *).
(Monad m, MonadFail m) =>
String -> m Extension
readExtension
([String] -> Parser [Extension])
-> Parser [String] -> Parser [Extension]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Maybe [String] -> [String])
-> Parser (Maybe [String]) -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe []) (Object
v Object -> Text -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Y..:? Text
"extensions"))
parseJSON Value
_ = String -> Parser Config
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected Object for Config value"
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
Config :: Int64 -> Int64 -> Bool -> Bool -> [String] -> [Extension] -> Config
Config
{ configMaxColumns :: Int64
configMaxColumns = Int64
80
, configIndentSpaces :: Int64
configIndentSpaces = Int64
2
, configTrailingNewline :: Bool
configTrailingNewline = Bool
True
, configSortImports :: Bool
configSortImports = Bool
True
, configLineBreaks :: [String]
configLineBreaks = []
, configExtensions :: [Extension]
configExtensions = []
}
data
= EndOfLine String
| MultiLine String
deriving (Int -> SomeComment -> String -> String
[SomeComment] -> String -> String
SomeComment -> String
(Int -> SomeComment -> String -> String)
-> (SomeComment -> String)
-> ([SomeComment] -> String -> String)
-> Show SomeComment
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SomeComment] -> String -> String
$cshowList :: [SomeComment] -> String -> String
show :: SomeComment -> String
$cshow :: SomeComment -> String
showsPrec :: Int -> SomeComment -> String -> String
$cshowsPrec :: Int -> SomeComment -> String -> String
Show, Eq SomeComment
Eq SomeComment
-> (SomeComment -> SomeComment -> Ordering)
-> (SomeComment -> SomeComment -> Bool)
-> (SomeComment -> SomeComment -> Bool)
-> (SomeComment -> SomeComment -> Bool)
-> (SomeComment -> SomeComment -> Bool)
-> (SomeComment -> SomeComment -> SomeComment)
-> (SomeComment -> SomeComment -> SomeComment)
-> Ord SomeComment
SomeComment -> SomeComment -> Bool
SomeComment -> SomeComment -> Ordering
SomeComment -> SomeComment -> SomeComment
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 :: SomeComment -> SomeComment -> SomeComment
$cmin :: SomeComment -> SomeComment -> SomeComment
max :: SomeComment -> SomeComment -> SomeComment
$cmax :: SomeComment -> SomeComment -> SomeComment
>= :: SomeComment -> SomeComment -> Bool
$c>= :: SomeComment -> SomeComment -> Bool
> :: SomeComment -> SomeComment -> Bool
$c> :: SomeComment -> SomeComment -> Bool
<= :: SomeComment -> SomeComment -> Bool
$c<= :: SomeComment -> SomeComment -> Bool
< :: SomeComment -> SomeComment -> Bool
$c< :: SomeComment -> SomeComment -> Bool
compare :: SomeComment -> SomeComment -> Ordering
$ccompare :: SomeComment -> SomeComment -> Ordering
$cp1Ord :: Eq SomeComment
Ord, SomeComment -> SomeComment -> Bool
(SomeComment -> SomeComment -> Bool)
-> (SomeComment -> SomeComment -> Bool) -> Eq SomeComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeComment -> SomeComment -> Bool
$c/= :: SomeComment -> SomeComment -> Bool
== :: SomeComment -> SomeComment -> Bool
$c== :: SomeComment -> SomeComment -> Bool
Eq)
data
= SrcSpan SomeComment
| SrcSpan SomeComment
| SrcSpan SomeComment
deriving (Int -> NodeComment -> String -> String
[NodeComment] -> String -> String
NodeComment -> String
(Int -> NodeComment -> String -> String)
-> (NodeComment -> String)
-> ([NodeComment] -> String -> String)
-> Show NodeComment
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NodeComment] -> String -> String
$cshowList :: [NodeComment] -> String -> String
show :: NodeComment -> String
$cshow :: NodeComment -> String
showsPrec :: Int -> NodeComment -> String -> String
$cshowsPrec :: Int -> NodeComment -> String -> String
Show, Eq NodeComment
Eq NodeComment
-> (NodeComment -> NodeComment -> Ordering)
-> (NodeComment -> NodeComment -> Bool)
-> (NodeComment -> NodeComment -> Bool)
-> (NodeComment -> NodeComment -> Bool)
-> (NodeComment -> NodeComment -> Bool)
-> (NodeComment -> NodeComment -> NodeComment)
-> (NodeComment -> NodeComment -> NodeComment)
-> Ord NodeComment
NodeComment -> NodeComment -> Bool
NodeComment -> NodeComment -> Ordering
NodeComment -> NodeComment -> NodeComment
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 :: NodeComment -> NodeComment -> NodeComment
$cmin :: NodeComment -> NodeComment -> NodeComment
max :: NodeComment -> NodeComment -> NodeComment
$cmax :: NodeComment -> NodeComment -> NodeComment
>= :: NodeComment -> NodeComment -> Bool
$c>= :: NodeComment -> NodeComment -> Bool
> :: NodeComment -> NodeComment -> Bool
$c> :: NodeComment -> NodeComment -> Bool
<= :: NodeComment -> NodeComment -> Bool
$c<= :: NodeComment -> NodeComment -> Bool
< :: NodeComment -> NodeComment -> Bool
$c< :: NodeComment -> NodeComment -> Bool
compare :: NodeComment -> NodeComment -> Ordering
$ccompare :: NodeComment -> NodeComment -> Ordering
$cp1Ord :: Eq NodeComment
Ord, NodeComment -> NodeComment -> Bool
(NodeComment -> NodeComment -> Bool)
-> (NodeComment -> NodeComment -> Bool) -> Eq NodeComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeComment -> NodeComment -> Bool
$c/= :: NodeComment -> NodeComment -> Bool
== :: NodeComment -> NodeComment -> Bool
$c== :: NodeComment -> NodeComment -> Bool
Eq)
data NodeInfo = NodeInfo
{ NodeInfo -> SrcSpanInfo
nodeInfoSpan :: !SrcSpanInfo
, :: ![NodeComment]
}
instance Show NodeInfo where
show :: NodeInfo -> String
show (NodeInfo SrcSpanInfo
_ []) = String
""
show (NodeInfo SrcSpanInfo
_ [NodeComment]
s) =
String
"{- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [NodeComment] -> String
forall a. Show a => a -> String
show [NodeComment]
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -}"