10e4330...master · hext

.hext.yaml+4

since splitsnapshots

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.

Setup.hs+2−6

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

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}

7

3

8import Distribution.Simple

4import Distribution.Simple

9main = defaultMain

5main = defaultMain

app/Main.hs+3−9

@@ -1,23 +1,17 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}

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

16−import Text.Megaparsec

17

11

18main :: IO ()

12main :: IO ()

19main = do

13main = do

20 Options{..} <- parseOptions

14 Options{..} <- parseOptions

21 configs <- getConfigs extensionsPath

15 configs <- getConfigs extensionsPath

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

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

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

17+ 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+35−23

@@ -1,38 +1,50 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE DeriveAnyClass #-}

1{-# LANGUAGE DeriveAnyClass #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE LambdaCase #-}

4+{-# LANGUAGE NoImplicitPrelude #-}

5+{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE RecordWildCards #-}

7+{-# LANGUAGE ScopedTypeVariables #-}

8+{-# LANGUAGE TypeApplications #-}

7

9

8module Control.Hext.Arguments

10module Control.Hext.Arguments

9− ( parseOptions

11+ ( parseOptions,

10− , Options(..)

12+ Options (..),

13+ )

11− ) where

14+where

12−

13−import Relude

14

15

15import Options.Applicative

16import Options.Applicative

17+import Relude

16

18

17parseOptions :: IO Options

19parseOptions :: IO Options

18−parseOptions = execParser $ info

20+parseOptions =

21+ execParser $

22+ info

19− (Options <$> activeDirectoryArgument <*> extensionsFilePath)

23+ (Options <$> activeDirectoryArgument <*> extensionsFilePath)

20− (fullDesc

24+ ( fullDesc

21− <> progDesc "Add GHC extensions to source files automatically.")

25+ <> progDesc "Add GHC extensions to source files automatically."

26+ )

22

27

23−data Options = Options

28+data Options

29+ = Options

24− { activeDirectory :: Maybe FilePath

30+ { activeDirectory :: Maybe FilePath,

25− , extensionsPath :: FilePath

31+ extensionsPath :: FilePath

26− }

32+ }

27

33

28activeDirectoryArgument :: Parser (Maybe FilePath)

34activeDirectoryArgument :: Parser (Maybe FilePath)

29−activeDirectoryArgument = argument (maybeReader $ (Just . Just))

35+activeDirectoryArgument =

36+ argument

37+ (maybeReader $ (Just . Just))

30 ( help "The directiry to scan for .hs files."

38 ( help "The directiry to scan for .hs files."

31− <> value Nothing )

39+ <> value Nothing

40+ )

32

41

33extensionsFilePath :: Parser FilePath

42extensionsFilePath :: Parser FilePath

34−extensionsFilePath = option auto

43+extensionsFilePath =

44+ option

45+ auto

35 ( short 'i'

46 ( short 'i'

36− <> long "input"

47+ <> long "input"

37− <> help "The input yaml filw with extensions."

48+ <> help "The input yaml file with extensions."

38− <> value ".hext.yaml" )

49+ <> value ".hext.yaml"

50+ )

src/Control/Hext/Config.hs+41−13

@@ -1,23 +1,51 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE DeriveAnyClass #-}

1{-# LANGUAGE DeriveAnyClass #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE LambdaCase #-}

4+{-# LANGUAGE NoImplicitPrelude #-}

5+{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE RecordWildCards #-}

7+{-# LANGUAGE ScopedTypeVariables #-}

8+{-# LANGUAGE TypeApplications #-}

7

9

8module Control.Hext.Config

10module Control.Hext.Config

9− ( getConfigs

11+ ( getConfigs,

10− , Config(..)

12+ Config (..),

13+ LineLimit (..),

14+ )

11− ) where

15+where

12

16

17+import Data.Aeson as A

18+import Data.Aeson.Casing

19+import Data.Scientific

20+import Data.Yaml

13import Relude

21import Relude

22+import System.Exit as SE

14

23

15−import Data.Yaml

24+data Config

25+ = Config

26+ { extensions :: [Text],

27+ src :: [FilePath],

28+ lineLimit :: Maybe LineLimit

29+ }

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

31+

32+instance FromJSON Config where

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

34+

35+data LineLimit

36+ = Limited Int

37+ | Unlimited

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

16

39

17−data Config = Config

40+instance FromJSON LineLimit where

18− { extensions :: [Text]

41+ parseJSON (A.Number n)

19− , src :: [FilePath]

42+ | Right n' <- floatingOrInteger @Double n,

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

43+ n' > 0 =

44+ return $ Limited n'

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

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

21

47

22getConfigs :: FilePath -> IO [Config]

48getConfigs :: FilePath -> IO [Config]

23−getConfigs = decodeFileThrow

49+getConfigs f =

50+ (fmap . fmap) (\c@Config {..} -> c {extensions = sort extensions}) $

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

src/Control/Hext/Processor.hs+56−33

@@ -1,46 +1,69 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}

7

3

8module Control.Hext.Processor

4module Control.Hext.Processor

9− ( processFiles

5+ ( processFiles,

6+ )

10− ) where

7+where

11

8

9+import Control.Hext.Config

10+import Data.Haskell.Parser

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

12+import qualified Data.Text as T

12import Relude

13import Relude

13−

14−import Data.List hiding (unlines)

15import System.Directory.Tree

14import System.Directory.Tree

16−import Data.Haskell.Parser

17

15

18getFiles :: FilePath -> IO [FilePath]

16getFiles :: FilePath -> IO [FilePath]

19getFiles dir = do

17getFiles dir = do

20− (_ :/ tree) <- readDirectoryWith return dir

18+ (_ :/ tree) <- readDirectoryWith return dir

21− return . (>>= getHs) . unwrapDir $ tree

19+ return . (>>= getHs) . unwrapDir $ tree

22− where

20+ where

23− unwrapDir :: DirTree a -> [DirTree a]

21+ unwrapDir :: DirTree a -> [DirTree a]

24− unwrapDir (Dir _ paths) = paths

22+ unwrapDir (Dir _ paths) = paths

25− unwrapDir _ = []

23+ unwrapDir _ = []

24+ getHs :: DirTree FilePath -> [FilePath]

25+ getHs (File _ path) | ".hs" `isSuffixOf` path = pure path

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

27+ getHs _ = []

26

28

27− getHs :: DirTree FilePath -> [FilePath]

28− getHs (File _ path) | ".hs" `isSuffixOf` path = pure path

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

30− getHs _ = []

31−

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

29+processFile :: Text -> Text -> Text

33processFile extensions file =

30processFile extensions file =

34− (unlines . fmap wrapExtension) extensions

31+ extensions

35 <> "\n"

32 <> "\n"

36 <> withoutExtensions file

33 <> withoutExtensions file

37− where

38− wrapExtension :: Text -> Text

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

40

34

35+wrapExtension :: Text -> Text

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

37+

38+baseLength :: Int

39+baseLength = T.length $ wrapExtension ""

40+

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

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

42−processFiles extensions dir = do

42+processFiles limit allExtensions dir = do

43− files <- getFiles dir

43+ files <- getFiles dir

44− forM_ files $ \file -> do

44+ forM_ files $ \file -> do

45− contents <- readFileText file

45+ contents <- readFileText file

46− writeFileText file . processFile extensions $ contents

46+ writeFileText file . processFile (wrapExtensions allExtensions) $ contents

47+ where

48+ wrapExtensions :: [Text] -> Text

49+ wrapExtensions [] = ""

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

51+ Nothing -> unlines . fmap wrapExtension $ extensions

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

53+ Just (Limited n) ->

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

55+ ee' =

56+ unfoldr

57+ ( \case

58+ Nothing -> Nothing

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

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

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

62+ in Just (current, Just thing)

63+ )

64+ (Just emptyExtra)

65+ (extraExtensions, eLeft, _) =

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

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

68+ <> "\n"

69+ <> wrapExtensions eLeft

src/Data/Haskell/Parser.hs+4−8

@@ -1,22 +1,18 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}

7

3

8module Data.Haskell.Parser

4module Data.Haskell.Parser

9 ( withoutExtensions

5 ( withoutExtensions

10 , withoutExtensionsParser

6 , withoutExtensionsParser

11 ) where

7 ) where

12

8

13−import Relude hiding (some, many)

9+import Relude hiding (many, some)

14

10

15import Text.Megaparsec

11import 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

stack.yaml+12

@@ -64,3 +64,15 @@ packages:

64#

65# Allow a newer minor version of GHC than the snapshot specifies

66# compiler-check: newer-minor

67+

68+ghc-options:

69+ "$locals":

70+ -Wall

71+ -Wincomplete-uni-patterns

72+ -Wincomplete-record-updates

73+ -Wmissing-exported-signatures

74+ -Wmissing-home-modules

75+ -Widentities

76+ -Wmissed-specialisations

77+ -Wall-missed-specialisations

78+ -Wno-unused-do-bind

test/Spec.hs+2−6

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

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−{-# LANGUAGE TypeApplications #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE DeriveAnyClass #-}

6−{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}

7

3

8main :: IO ()

4main :: IO ()

9main = putStrLn "Test suite not yet implemented"

5main = putStrLn "Test suite not yet implemented"