on 20a4ea9 help sign in
13 files changed+98−400
since splitsnapshots
unifiedsplit
.hext.yaml−4 .stylish-haskell.yaml−229 README.md−6 Setup.hs+6−2 app/Main.hs+9−3 beforebuild−2 package.yaml−4 src/Control/Hext/Arguments.hs+23−35 src/Control/Hext/Config.hs+13−41 src/Control/Hext/Processor.hs+33−56 src/Data/Haskell/Parser.hs+8−4 stack.yaml−12 test/Spec.hs+6−2
.hext.yaml−4
@@ -3,8 +3,6 @@
33 - tests
44 - app
55
6− line_limit: 100
7−
86 extensions:
97 - OverloadedStrings
108 - NoImplicitPrelude
@@ -12,5 +10,3 @@
1210 - DeriveGeneric
1311 - DeriveAnyClass
1412 - RecordWildCards
15− - ScopedTypeVariables
16− - LambdaCase
.stylish-haskell.yamldeleted−229
@@ -1,229 +0,0 @@
1−# stylish-haskell configuration file
2−# ==================================
3−
4−# The stylish-haskell tool is mainly configured by specifying steps. These steps
5−# are a list, so they have an order, and one specific step may appear more than
6−# once (if needed). Each file is processed by these steps in the given order.
7−steps:
8− # Convert some ASCII sequences to their Unicode equivalents. This is disabled
9− # by default.
10− # - unicode_syntax:
11− # # In order to make this work, we also need to insert the UnicodeSyntax
12− # # language pragma. If this flag is set to true, we insert it when it's
13− # # not already present. You may want to disable it if you configure
14− # # language extensions using some other method than pragmas. Default:
15− # # true.
16− # add_language_pragma: true
17−
18− # Align the right hand side of some elements. This is quite conservative
19− # and only applies to statements where each element occupies a single
20− # line.
21−# - simple_align:
22−# cases: true
23−# top_level_patterns: true
24−# records: true
25−
26− # Import cleanup
27− - imports:
28− # There are different ways we can align names and lists.
29− #
30− # - global: Align the import names and import list throughout the entire
31− # file.
32− #
33− # - file: Like global, but don't add padding when there are no qualified
34− # imports in the file.
35− #
36− # - group: Only align the imports per group (a group is formed by adjacent
37− # import lines).
38− #
39− # - none: Do not perform any alignment.
40− #
41− # Default: global.
42− align: none
43−
44− # The following options affect only import list alignment.
45− #
46− # List align has following options:
47− #
48− # - after_alias: Import list is aligned with end of import including
49− # 'as' and 'hiding' keywords.
50− #
51− # > import qualified Data.List as List (concat, foldl, foldr, head,
52− # > init, last, length)
53− #
54− # - with_alias: Import list is aligned with start of alias or hiding.
55− #
56− # > import qualified Data.List as List (concat, foldl, foldr, head,
57− # > init, last, length)
58− #
59− # - new_line: Import list starts always on new line.
60− #
61− # > import qualified Data.List as List
62− # > (concat, foldl, foldr, head, init, last, length)
63− #
64− # Default: after_alias
65− list_align: after_alias
66−
67− # Right-pad the module names to align imports in a group:
68− #
69− # - true: a little more readable
70− #
71− # > import qualified Data.List as List (concat, foldl, foldr,
72− # > init, last, length)
73− # > import qualified Data.List.Extra as List (concat, foldl, foldr,
74− # > init, last, length)
75− #
76− # - false: diff-safe
77− #
78− # > import qualified Data.List as List (concat, foldl, foldr, init,
79− # > last, length)
80− # > import qualified Data.List.Extra as List (concat, foldl, foldr,
81− # > init, last, length)
82− #
83− # Default: true
84− pad_module_names: false
85−
86− # Long list align style takes effect when import is too long. This is
87− # determined by 'columns' setting.
88− #
89− # - inline: This option will put as much specs on same line as possible.
90− #
91− # - new_line: Import list will start on new line.
92− #
93− # - new_line_multiline: Import list will start on new line when it's
94− # short enough to fit to single line. Otherwise it'll be multiline.
95− #
96− # - multiline: One line per import list entry.
97− # Type with constructor list acts like single import.
98− #
99− # > import qualified Data.Map as M
100− # > ( empty
101− # > , singleton
102− # > , ...
103− # > , delete
104− # > )
105− #
106− # Default: inline
107− long_list_align: inline
108−
109− # Align empty list (importing instances)
110− #
111− # Empty list align has following options
112− #
113− # - inherit: inherit list_align setting
114− #
115− # - right_after: () is right after the module name:
116− #
117− # > import Vector.Instances ()
118− #
119− # Default: inherit
120− empty_list_align: inherit
121−
122− # List padding determines indentation of import list on lines after import.
123− # This option affects 'long_list_align'.
124− #
125− # - <integer>: constant value
126− #
127− # - module_name: align under start of module name.
128− # Useful for 'file' and 'group' align settings.
129− list_padding: 4
130−
131− # Separate lists option affects formatting of import list for type
132− # or class. The only difference is single space between type and list
133− # of constructors, selectors and class functions.
134− #
135− # - true: There is single space between Foldable type and list of it's
136− # functions.
137− #
138− # > import Data.Foldable (Foldable (fold, foldl, foldMap))
139− #
140− # - false: There is no space between Foldable type and list of it's
141− # functions.
142− #
143− # > import Data.Foldable (Foldable(fold, foldl, foldMap))
144− #
145− # Default: true
146− separate_lists: true
147−
148− # Space surround option affects formatting of import lists on a single
149− # line. The only difference is single space after the initial
150− # parenthesis and a single space before the terminal parenthesis.
151− #
152− # - true: There is single space associated with the enclosing
153− # parenthesis.
154− #
155− # > import Data.Foo ( foo )
156− #
157− # - false: There is no space associated with the enclosing parenthesis
158− #
159− # > import Data.Foo (foo)
160− #
161− # Default: false
162− space_surround: false
163−
164− # Language pragmas
165−# - language_pragmas:
166−# # We can generate different styles of language pragma lists.
167−# #
168−# # - vertical: Vertical-spaced language pragmas, one per line.
169−# #
170−# # - compact: A more compact style.
171−# #
172−# # - compact_line: Similar to compact, but wrap each line with
173−# # `{-#LANGUAGE #-}'.
174−# #
175−# # Default: vertical.
176−# style: vertical
177−
178−# # Align affects alignment of closing pragma brackets.
179−# #
180−# # - true: Brackets are aligned in same column.
181−# #
182−# # - false: Brackets are not aligned together. There is only one space
183−# # between actual import and closing bracket.
184−# #
185−# # Default: true
186−# align: true
187−
188−# # stylish-haskell can detect redundancy of some language pragmas. If this
189−# # is set to true, it will remove those redundant pragmas. Default: true.
190−# remove_redundant: true
191−
192− # Replace tabs by spaces. This is disabled by default.
193− # - tabs:
194− # # Number of spaces to use for each tab. Default: 8, as specified by the
195− # # Haskell report.
196− # spaces: 8
197−
198− # Remove trailing whitespace
199−# - trailing_whitespace: {}
200−
201− # Squash multiple spaces between the left and right hand sides of some
202− # elements into single spaces. Basically, this undoes the effect of
203− # simple_align but is a bit less conservative.
204− # - squash: {}
205−
206−# A common setting is the number of columns (parts of) code will be wrapped
207−# to. Different steps take this into account. Default: 80.
208−columns: 100
209−
210−# By default, line endings are converted according to the OS. You can override
211−# preferred format here.
212−#
213−# - native: Native newline format. CRLF on Windows, LF on other OSes.
214−#
215−# - lf: Convert to LF ("\n").
216−#
217−# - crlf: Convert to CRLF ("\r\n").
218−#
219−# Default: native.
220−# newline: native
221−
222−# Sometimes, language extensions are specified in a cabal file or from the
223−# command line instead of using language pragmas in the file. stylish-haskell
224−# needs to be aware of these, so it can parse the file correctly.
225−#
226−# No language extensions are enabled by default.
227−# language_extensions:
228− # - TemplateHaskell
229− # - QuasiQuotes
README.md−6
@@ -12,8 +12,6 @@ Create a `.hext.yaml` file and put it into your project directory:
1212 - tests
1313 - app
1414
15− line_limit: 100
16−
1715 extensions:
1816 - OverloadedStrings
1917 - NoImplicitPrelude
@@ -21,10 +19,6 @@ Create a `.hext.yaml` file and put it into your project directory:
2119 - DeriveGeneric
2220 - DeriveAnyClass
2321 - RecordWildCards
24− - ScopedTypeVariables
25− - LambdaCase
2622```
2723
2824You 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+6−2
@@ -1,5 +1,9 @@
1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveAnyClass #-}
6+{-# LANGUAGE RecordWildCards #-}
37
48import Distribution.Simple
59main = defaultMain
app/Main.hs+9−3
@@ -1,17 +1,23 @@
1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveAnyClass #-}
6+{-# LANGUAGE RecordWildCards #-}
37
48module Main where
59
610import Relude
711
12+import Data.Haskell.Parser
813import Control.Hext.Arguments
914import Control.Hext.Config
1015import Control.Hext.Processor
16+import Text.Megaparsec
1117
1218main :: IO ()
1319main = do
1420 Options{..} <- parseOptions
1521 configs <- getConfigs extensionsPath
1622 forM_ configs $ \Config{..} ->
17− mapM_ (processFiles lineLimit extensions) $ maybe src pure activeDirectory
23+ mapM_ (processFiles extensions) $ maybe src pure activeDirectory
beforebuilddeleted−2
@@ -1,2 +0,0 @@
1−#!/bin/sh
2−hext
package.yaml−4
@@ -24,12 +24,8 @@ dependencies:
2424- megaparsec
2525- relude
2626- yaml
27−- aeson
28−- aeson-casing
2927- optparse-applicative
3028- directory-tree
31−- scientific
32−- text
3329
3430library:
3531 source-dirs: src
src/Control/Hext/Arguments.hs+23−35
@@ -1,50 +1,38 @@
1−{-# LANGUAGE DeriveAnyClass #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE LambdaCase #-}
4−{-# LANGUAGE NoImplicitPrelude #-}
51{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE RecordWildCards #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
83{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveAnyClass #-}
6+{-# LANGUAGE RecordWildCards #-}
97
108module Control.Hext.Arguments
11− ( parseOptions,
12− Options (..),
13− )
14−where
9+ ( parseOptions
10+ , Options(..)
11+ ) where
1512
16−import Options.Applicative
1713import Relude
1814
15+import Options.Applicative
16+
1917parseOptions :: IO Options
20−parseOptions =
21− execParser $
22− info
23− (Options <$> activeDirectoryArgument <*> extensionsFilePath)
24− ( fullDesc
25− <> progDesc "Add GHC extensions to source files automatically."
26− )
18+parseOptions = execParser $ info
19+ (Options <$> activeDirectoryArgument <*> extensionsFilePath)
20+ (fullDesc
21+ <> progDesc "Add GHC extensions to source files automatically.")
2722
28−data Options
29− = Options
30− { activeDirectory :: Maybe FilePath,
31− extensionsPath :: FilePath
32− }
23+data Options = Options
24+ { activeDirectory :: Maybe FilePath
25+ , extensionsPath :: FilePath
26+ }
3327
3428activeDirectoryArgument :: Parser (Maybe FilePath)
35−activeDirectoryArgument =
36− argument
37− (maybeReader $ (Just . Just))
29+activeDirectoryArgument = argument (maybeReader $ (Just . Just))
3830 ( help "The directiry to scan for .hs files."
39− <> value Nothing
40− )
31+ <> value Nothing )
4132
4233extensionsFilePath :: Parser FilePath
43−extensionsFilePath =
44− option
45− auto
34+extensionsFilePath = option auto
4635 ( short 'i'
47− <> long "input"
48− <> help "The input yaml file with extensions."
49− <> value ".hext.yaml"
50− )
36+ <> long "input"
37+ <> help "The input yaml filw with extensions."
38+ <> value ".hext.yaml" )
src/Control/Hext/Config.hs+13−41
@@ -1,51 +1,23 @@
1−{-# LANGUAGE DeriveAnyClass #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE LambdaCase #-}
4−{-# LANGUAGE NoImplicitPrelude #-}
51{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE RecordWildCards #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
83{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveAnyClass #-}
6+{-# LANGUAGE RecordWildCards #-}
97
108module Control.Hext.Config
11− ( getConfigs,
12− Config (..),
13− LineLimit (..),
14− )
15−where
9+ ( getConfigs
10+ , Config(..)
11+ ) where
1612
17−import Data.Aeson as A
18−import Data.Aeson.Casing
19−import Data.Scientific
20−import Data.Yaml
2113import Relude
22−import System.Exit as SE
2314
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)
15+import Data.Yaml
3916
40−instance FromJSON LineLimit where
41− parseJSON (A.Number n)
42− | Right n' <- floatingOrInteger @Double n,
43− n' > 0 =
44− return $ Limited n'
45− parseJSON (A.String "none") = return Unlimited
46− parseJSON _ = fail "invalid line-limit value"
17+data Config = Config
18+ { extensions :: [Text]
19+ , src :: [FilePath]
20+ } deriving (Show, Eq, Ord, Generic, FromJSON)
4721
4822getConfigs :: FilePath -> IO [Config]
49−getConfigs f =
50− (fmap . fmap) (\c@Config {..} -> c {extensions = sort extensions}) $
51− decodeFileEither f >>= either (SE.die . prettyPrintParseException) return
23+getConfigs = decodeFileThrow
src/Control/Hext/Processor.hs+33−56
@@ -1,69 +1,46 @@
1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveAnyClass #-}
6+{-# LANGUAGE RecordWildCards #-}
37
48module Control.Hext.Processor
5− ( processFiles,
6− )
7−where
9+ ( processFiles
10+ ) where
811
9−import Control.Hext.Config
10−import Data.Haskell.Parser
11−import Data.List hiding (head, unlines)
12−import qualified Data.Text as T
1312import Relude
13+
14+import Data.List hiding (unlines)
1415import System.Directory.Tree
16+import Data.Haskell.Parser
1517
1618getFiles :: FilePath -> IO [FilePath]
1719getFiles dir = do
18− (_ :/ tree) <- readDirectoryWith return dir
19− return . (>>= getHs) . unwrapDir $ tree
20− where
21− unwrapDir :: DirTree a -> [DirTree a]
22− unwrapDir (Dir _ paths) = paths
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 _ = []
20+ (_ :/ tree) <- readDirectoryWith return dir
21+ return . (>>= getHs) . unwrapDir $ tree
22+ where
23+ unwrapDir :: DirTree a -> [DirTree a]
24+ unwrapDir (Dir _ paths) = paths
25+ unwrapDir _ = []
2826
29−processFile :: Text -> Text -> Text
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
3033processFile extensions file =
31− extensions
34+ (unlines . fmap wrapExtension) extensions
3235 <> "\n"
3336 <> withoutExtensions file
37+ where
38+ wrapExtension :: Text -> Text
39+ wrapExtension e = "{-# LANGUAGE " <> e <> " #-}"
3440
35−wrapExtension :: Text -> Text
36−wrapExtension ee = "{-# LANGUAGE " <> ee <> " #-}"
37−
38−baseLength :: Int
39−baseLength = T.length $ wrapExtension ""
40−
41−processFiles :: Maybe LineLimit -> [Text] -> FilePath -> IO ()
42−processFiles limit allExtensions dir = do
43− files <- getFiles dir
44− forM_ files $ \file -> do
45− contents <- readFileText file
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
41+processFiles :: [Text] -> FilePath -> IO ()
42+processFiles extensions dir = do
43+ files <- getFiles dir
44+ forM_ files $ \file -> do
45+ contents <- readFileText file
46+ writeFileText file . processFile extensions $ contents
src/Data/Haskell/Parser.hs+8−4
@@ -1,18 +1,22 @@
1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveAnyClass #-}
6+{-# LANGUAGE RecordWildCards #-}
37
48module Data.Haskell.Parser
59 ( withoutExtensions
610 , withoutExtensionsParser
711 ) where
812
9−import Relude hiding (many, some)
13+import Relude hiding (some, many)
1014
1115import Text.Megaparsec
1216import Text.Megaparsec.Char
1317
1418withoutExtensions :: Text -> Text
15−withoutExtensions t = fromMaybe t $ (parseMaybe @()) withoutExtensionsParser t
19+withoutExtensions t = fromMaybe t $ flip (parseMaybe @()) t withoutExtensionsParser
1620
1721withoutExtensionsParser :: (Ord e) => ParsecT e Text m Text
1822withoutExtensionsParser = do
stack.yaml−12
@@ -64,15 +64,3 @@ packages:
6464#
6565# Allow a newer minor version of GHC than the snapshot specifies
6666# 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+6−2
@@ -1,5 +1,9 @@
1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveAnyClass #-}
6+{-# LANGUAGE RecordWildCards #-}
37
48main :: IO ()
59main = putStrLn "Test suite not yet implemented"