e70c298 · hext · git.iko.soy

git.iko.soy/hext

Added line_limit argument into config

commite70c2984e704122dd10a3d6c077f7274ede1a6d7 authoriko <ilyakooo0@gmail.com> dateSun 11 Aug 2019, 01:45 (7 years ago) parent10e4330

8 files changed+86−46

compare with master

unifiedsplit

.hext.yaml+4 README.md+6 app/Main.hs+4−8 package.yaml+4 src/Control/Hext/Arguments.hs+2−6 src/Control/Hext/Config.hs+26−8 src/Control/Hext/Processor.hs+37−17 src/Data/Haskell/Parser.hs+3−7

.hext.yaml+4

@@ -3,6 +3,8 @@

33 - tests

44 - app

6+ line_limit: 100

68 extensions:

79 - OverloadedStrings

810 - NoImplicitPrelude

@@ -10,3 +12,5 @@

1012 - DeriveGeneric

1113 - DeriveAnyClass

1214 - RecordWildCards

15+ - ScopedTypeVariables

16+ - LambdaCase

README.md+6

@@ -12,6 +12,8 @@ Create a `.hext.yaml` file and put it into your project directory:

1212 - tests

1313 - app

1414

15+ line_limit: 100

16+

1517 extensions:

1618 - OverloadedStrings

1719 - NoImplicitPrelude

@@ -19,6 +21,10 @@ Create a `.hext.yaml` file and put it into your project directory:

1921 - DeriveGeneric

2022 - DeriveAnyClass

2123 - RecordWildCards

24+ - ScopedTypeVariables

25+ - LambdaCase

2226```

2327

2428You can create multiple groups with different GHC extensions.

29+

30+`line_limit` can be abset, indicating that every extensions should be on its own line, a positive int or `none`, indicating that all extensions should be placed on one lines.

app/Main.hs+4−8

@@ -1,18 +1,14 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeApplications, NoImplicitPrelude #-}

2+{-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables, RecordWildCards #-}

84module Main where

106import Relude

117

12−import Data.Haskell.Parser

138import Control.Hext.Arguments

149import Control.Hext.Config

1510import Control.Hext.Processor

11+import Data.Haskell.Parser

1612import Text.Megaparsec

1713

1814main :: IO ()

@@ -20,4 +16,4 @@ main = do

2016 Options{..} <- parseOptions

2117 configs <- getConfigs extensionsPath

2218 forM_ configs $ \Config{..} ->

23− mapM_ (processFiles extensions) $ maybe src pure activeDirectory

19+ mapM_ (processFiles lineLimit extensions) $ maybe src pure activeDirectory

package.yaml+4

@@ -24,8 +24,12 @@ dependencies:

2424- megaparsec

2525- relude

2626- yaml

27+- aeson

28+- aeson-casing

2729- optparse-applicative

2830- directory-tree

31+- scientific

32+- text

2933

3034library:

3135 source-dirs: src

src/Control/Hext/Arguments.hs+2−6

@@ -1,9 +1,5 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeApplications, NoImplicitPrelude #-}

2+{-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables, RecordWildCards #-}

84module Control.Hext.Arguments

95 ( parseOptions

src/Control/Hext/Config.hs+26−8

@@ -1,23 +1,41 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeApplications, NoImplicitPrelude #-}

2+{-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables, RecordWildCards #-}

84module Control.Hext.Config

95 ( getConfigs

106 , Config(..)

7+ , LineLimit(..)

118 ) where

129

1310import Relude

1411

12+import Data.Aeson as A

13+import Data.Aeson.Casing

14+import Data.Scientific

1515import Data.Yaml

16+import System.Exit as SE

1617

1718data Config = Config

1819 { extensions :: [Text]

1920 , src :: [FilePath]

20− } deriving (Show, Eq, Ord, Generic, FromJSON)

21+ , lineLimit :: Maybe LineLimit

22+ } deriving (Show, Eq, Ord, Generic)

23+

24+instance FromJSON Config where

25+ parseJSON = genericParseJSON $ defaultOptions { fieldLabelModifier = snakeCase }

26+

27+data LineLimit

28+ = Limited Int

29+ | Unlimited

30+ deriving (Show, Generic, Eq, Ord)

31+

32+instance FromJSON LineLimit where

33+ parseJSON (A.Number n)

34+ | Right n' <- floatingOrInteger n

35+ , n' > 0

36+ = return $ Limited n'

37+ parseJSON (A.String "none") = return Unlimited

38+ parseJSON _ = fail "invalid line-limit value"

2139

2240getConfigs :: FilePath -> IO [Config]

23−getConfigs = decodeFileThrow

41+getConfigs f = decodeFileEither f >>= either (SE.die . prettyPrintParseException) return

src/Control/Hext/Processor.hs+37−17

@@ -1,9 +1,5 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeApplications, NoImplicitPrelude #-}

2+{-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables, RecordWildCards #-}

84module Control.Hext.Processor

95 ( processFiles

@@ -11,9 +7,11 @@ module Control.Hext.Processor

117

128import Relude

139

14−import Data.List hiding (unlines)

15−import System.Directory.Tree

10+import Control.Hext.Config

1611import Data.Haskell.Parser

12+import Data.List hiding (head, unlines)

13+import qualified Data.Text as T

14+import System.Directory.Tree

1715

1816getFiles :: FilePath -> IO [FilePath]

1917getFiles dir = do

@@ -29,18 +27,40 @@ getFiles dir = do

2927 getHs (Dir name paths) | not $ "." `isPrefixOf` name = paths >>= getHs

3028 getHs _ = []

3129

32−processFile :: [Text] -> Text -> Text

33−processFile extensions file =

34− (unlines . fmap wrapExtension) extensions

30+processFile :: Maybe LineLimit -> Text -> Text -> Text

31+processFile limit extensions file =

32+ extensions

3533 <> "\n"

3634 <> withoutExtensions file

37− where

38− wrapExtension :: Text -> Text

39− wrapExtension e = "{-# LANGUAGE " <> e <> " #-}"

4035

41−processFiles :: [Text] -> FilePath -> IO ()

42−processFiles extensions dir = do

36+wrapExtension :: Text -> Text

37+wrapExtension ee = "{-# LANGUAGE " <> ee <> " #-}"

38+

39+baseLength :: Int

40+baseLength = T.length $ wrapExtension ""

41+

42+processFiles :: Maybe LineLimit -> [Text] -> FilePath -> IO ()

43+processFiles limit extensions dir = do

4344 files <- getFiles dir

4445 forM_ files $ \file -> do

4546 contents <- readFileText file

46− writeFileText file . processFile extensions $ contents

47+ writeFileText file . processFile limit (wrapExtensions extensions) $ contents

48+ where

49+ wrapExtensions :: [Text] -> Text

50+ wrapExtensions [] = ""

51+ wrapExtensions extensions@(e:ee) = case limit of

52+ Nothing -> unlines . fmap wrapExtension $ extensions

53+ Just Unlimited -> unlines . pure . wrapExtension . mconcat . intersperse ", " $ extensions

54+ Just (Limited n) ->

55+ let emptyExtra = ([], ee, baseLength + T.length e)

56+ ee' = unfoldr (\case

57+ Nothing -> Nothing

58+ (Just current@(_, [], _)) -> Just (current, Nothing)

59+ (Just current@(soFar, ne:next, l)) ->

60+ let thing = (ne:soFar, next, l + T.length ne + 2)

61+ in Just (current, Just thing))

62+ (Just emptyExtra)

63+ (extraExtensions, eLeft, _) =

64+ fromMaybe emptyExtra . viaNonEmpty head . reverse . filter (\(_, _, n') -> n' <= n) $ ee'

65+ in (wrapExtension . mconcat . intersperse ", " $ e:extraExtensions)

66+ <> "\n" <> wrapExtensions eLeft

src/Data/Haskell/Parser.hs+3−7

@@ -1,9 +1,5 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeApplications, NoImplicitPrelude #-}

2+{-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables, RecordWildCards #-}

84module Data.Haskell.Parser

95 ( withoutExtensions

@@ -16,7 +12,7 @@ import Text.Megaparsec

1612import Text.Megaparsec.Char

1713

1814withoutExtensions :: Text -> Text

19−withoutExtensions t = fromMaybe t $ flip (parseMaybe @()) t withoutExtensionsParser

15+withoutExtensions t = fromMaybe t $ (parseMaybe @()) withoutExtensionsParser t

2016

2117withoutExtensionsParser :: (Ord e) => ParsecT e Text m Text

2218withoutExtensionsParser = do