e70c298 · hext · git.iko.soy

.hext.yaml+4

compare with master

unifiedsplit

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

3 - tests

4 - app

5

6+ line_limit: 100

7+

6 extensions:

8 extensions:

7 - OverloadedStrings

9 - OverloadedStrings

8 - NoImplicitPrelude

10 - NoImplicitPrelude

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

10 - DeriveGeneric

12 - DeriveGeneric

11 - DeriveAnyClass

13 - DeriveAnyClass

12 - RecordWildCards

14 - RecordWildCards

15+ - ScopedTypeVariables

16+ - LambdaCase

README.md+6

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

12 - tests

13 - app

14

15+ line_limit: 100

16+

15 extensions:

17 extensions:

16 - OverloadedStrings

18 - OverloadedStrings

17 - NoImplicitPrelude

19 - NoImplicitPrelude

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

19 - DeriveGeneric

21 - DeriveGeneric

20 - DeriveAnyClass

22 - DeriveAnyClass

21 - RecordWildCards

23 - RecordWildCards

24+ - ScopedTypeVariables

25+ - LambdaCase

22```

26```

23

27

24You can create multiple groups with different GHC extensions.

28You 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 #-}

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

2−{-# LANGUAGE NoImplicitPrelude #-}

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

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

7

3

8module Main where

4module Main where

9

5

10import Relude

6import Relude

11

7

12−import Data.Haskell.Parser

13import Control.Hext.Arguments

8import Control.Hext.Arguments

14import Control.Hext.Config

9import Control.Hext.Config

15import Control.Hext.Processor

10import Control.Hext.Processor

11+import Data.Haskell.Parser

16import Text.Megaparsec

12import Text.Megaparsec

17

13

18main :: IO ()

14main :: IO ()

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

20 Options{..} <- parseOptions

16 Options{..} <- parseOptions

21 configs <- getConfigs extensionsPath

17 configs <- getConfigs extensionsPath

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

18 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:

24- megaparsec

25- relude

26- yaml

27+- aeson

28+- aeson-casing

27- optparse-applicative

29- optparse-applicative

28- directory-tree

30- directory-tree

31+- scientific

32+- text

29

33

30library:

34library:

31 source-dirs: src

35 source-dirs: src

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

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

1−{-# LANGUAGE OverloadedStrings #-}

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

2−{-# LANGUAGE NoImplicitPrelude #-}

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

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

7

3

8module Control.Hext.Arguments

4module Control.Hext.Arguments

9 ( parseOptions

5 ( parseOptions

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

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

1−{-# LANGUAGE OverloadedStrings #-}

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

2−{-# LANGUAGE NoImplicitPrelude #-}

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

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

7

3

8module Control.Hext.Config

4module Control.Hext.Config

9 ( getConfigs

5 ( getConfigs

10 , Config(..)

6 , Config(..)

7+ , LineLimit(..)

11 ) where

8 ) where

12

9

13import Relude

10import Relude

14

11

12+import Data.Aeson as A

13+import Data.Aeson.Casing

14+import Data.Scientific

15import Data.Yaml

16+import System.Exit as SE

16

17

17data Config = Config

18data Config = Config

18 { extensions :: [Text]

19 { extensions :: [Text]

19 , src :: [FilePath]

20 , src :: [FilePath]

21+ , lineLimit :: Maybe LineLimit

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

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"

21

39

22getConfigs :: FilePath -> IO [Config]

40getConfigs :: 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 #-}

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

2−{-# LANGUAGE NoImplicitPrelude #-}

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

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

7

3

8module Control.Hext.Processor

4module Control.Hext.Processor

9 ( processFiles

5 ( processFiles

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

11

7

12import Relude

8import Relude

13

9

14−import Data.List hiding (unlines)

10+import Control.Hext.Config

15−import System.Directory.Tree

16import Data.Haskell.Parser

11import Data.Haskell.Parser

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

13+import qualified Data.Text as T

14+import System.Directory.Tree

17

15

18getFiles :: FilePath -> IO [FilePath]

16getFiles :: FilePath -> IO [FilePath]

19getFiles dir = do

17getFiles dir = do

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

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

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

30 getHs _ = []

28 getHs _ = []

31

29

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

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

33−processFile extensions file =

31+processFile limit extensions file =

34− (unlines . fmap wrapExtension) extensions

32+ extensions

35 <> "\n"

33 <> "\n"

36 <> withoutExtensions file

34 <> withoutExtensions file

37− where

38− wrapExtension :: Text -> Text

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

40

35

36+wrapExtension :: Text -> Text

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

38+

39+baseLength :: Int

40+baseLength = T.length $ wrapExtension ""

41+

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

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

42−processFiles extensions dir = do

43+processFiles limit extensions dir = do

43 files <- getFiles dir

44 files <- getFiles dir

44 forM_ files $ \file -> do

45 forM_ files $ \file -> do

45 contents <- readFileText file

46 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 #-}

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

2−{-# LANGUAGE NoImplicitPrelude #-}

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

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

7

3

8module Data.Haskell.Parser

4module Data.Haskell.Parser

9 ( withoutExtensions

5 ( withoutExtensions

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

16import Text.Megaparsec.Char

12import Text.Megaparsec.Char

17

13

18withoutExtensions :: Text -> Text

14withoutExtensions :: Text -> Text

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

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

20

16

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

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

22withoutExtensionsParser = do

18withoutExtensionsParser = do