on master help sign in
13 files changed+400−98
since splitsnapshots
unifiedsplit
.hext.yaml+4 .stylish-haskell.yaml+229 README.md+6 Setup.hs+2−6 app/Main.hs+3−9 beforebuild+2 package.yaml+4 src/Control/Hext/Arguments.hs+35−23 src/Control/Hext/Config.hs+41−13 src/Control/Hext/Processor.hs+56−33 src/Data/Haskell/Parser.hs+4−8 stack.yaml+12 test/Spec.hs+2−6
.hext.yaml+4
@@ -3,6 +3,8 @@
33 - tests
44 - app
55
6+ line_limit: 100
7+
68 extensions:
79 - OverloadedStrings
810 - NoImplicitPrelude
@@ -10,3 +12,5 @@
1012 - DeriveGeneric
1113 - DeriveAnyClass
1214 - RecordWildCards
15+ - ScopedTypeVariables
16+ - LambdaCase
.stylish-haskell.yamlnew file+229
@@ -0,0 +1,229 @@
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,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.
Setup.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 DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
73
84import Distribution.Simple
95main = defaultMain
app/Main.hs+3−9
@@ -1,23 +1,17 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE TypeApplications #-}
4−{-# LANGUAGE DeriveGeneric #-}
5−{-# LANGUAGE DeriveAnyClass #-}
6−{-# LANGUAGE RecordWildCards #-}
1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
73
84module Main where
95
106import Relude
117
12−import Data.Haskell.Parser
138import Control.Hext.Arguments
149import Control.Hext.Config
1510import Control.Hext.Processor
16−import Text.Megaparsec
1711
1812main :: IO ()
1913main = do
2014 Options{..} <- parseOptions
2115 configs <- getConfigs extensionsPath
2216 forM_ configs $ \Config{..} ->
23− mapM_ (processFiles extensions) $ maybe src pure activeDirectory
17+ mapM_ (processFiles lineLimit extensions) $ maybe src pure activeDirectory
beforebuildnew file+2
@@ -0,0 +1,2 @@
1+#!/bin/sh
2+hext
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+35−23
@@ -1,38 +1,50 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE TypeApplications #-}
4−{-# LANGUAGE DeriveGeneric #-}
51{-# LANGUAGE DeriveAnyClass #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE LambdaCase #-}
4+{-# LANGUAGE NoImplicitPrelude #-}
5+{-# LANGUAGE OverloadedStrings #-}
66{-# LANGUAGE RecordWildCards #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE TypeApplications #-}
79
810module Control.Hext.Arguments
9− ( parseOptions
10− , Options(..)
11− ) where
12−
13−import Relude
11+ ( parseOptions,
12+ Options (..),
13+ )
14+where
1415
1516import Options.Applicative
17+import Relude
1618
1719parseOptions :: IO Options
18−parseOptions = execParser $ info
19− (Options <$> activeDirectoryArgument <*> extensionsFilePath)
20− (fullDesc
21− <> progDesc "Add GHC extensions to source files automatically.")
20+parseOptions =
21+ execParser $
22+ info
23+ (Options <$> activeDirectoryArgument <*> extensionsFilePath)
24+ ( fullDesc
25+ <> progDesc "Add GHC extensions to source files automatically."
26+ )
2227
23−data Options = Options
24− { activeDirectory :: Maybe FilePath
25− , extensionsPath :: FilePath
26− }
28+data Options
29+ = Options
30+ { activeDirectory :: Maybe FilePath,
31+ extensionsPath :: FilePath
32+ }
2733
2834activeDirectoryArgument :: Parser (Maybe FilePath)
29−activeDirectoryArgument = argument (maybeReader $ (Just . Just))
35+activeDirectoryArgument =
36+ argument
37+ (maybeReader $ (Just . Just))
3038 ( help "The directiry to scan for .hs files."
31− <> value Nothing )
39+ <> value Nothing
40+ )
3241
3342extensionsFilePath :: Parser FilePath
34−extensionsFilePath = option auto
43+extensionsFilePath =
44+ option
45+ auto
3546 ( short 'i'
36− <> long "input"
37− <> help "The input yaml filw with extensions."
38− <> value ".hext.yaml" )
47+ <> long "input"
48+ <> help "The input yaml file with extensions."
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 #-}
51{-# LANGUAGE DeriveAnyClass #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE LambdaCase #-}
4+{-# LANGUAGE NoImplicitPrelude #-}
5+{-# LANGUAGE OverloadedStrings #-}
66{-# LANGUAGE RecordWildCards #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE TypeApplications #-}
79
810module Control.Hext.Config
9− ( getConfigs
10− , Config(..)
11− ) where
11+ ( getConfigs,
12+ Config (..),
13+ LineLimit (..),
14+ )
15+where
1216
17+import Data.Aeson as A
18+import Data.Aeson.Casing
19+import Data.Scientific
20+import Data.Yaml
1321import Relude
22+import System.Exit as SE
1423
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)
1639
17−data Config = Config
18− { extensions :: [Text]
19− , src :: [FilePath]
20− } deriving (Show, Eq, Ord, Generic, FromJSON)
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"
2147
2248getConfigs :: 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 #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE TypeApplications #-}
4−{-# LANGUAGE DeriveGeneric #-}
5−{-# LANGUAGE DeriveAnyClass #-}
6−{-# LANGUAGE RecordWildCards #-}
1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
73
84module Control.Hext.Processor
9− ( processFiles
10− ) where
5+ ( processFiles,
6+ )
7+where
118
9+import Control.Hext.Config
10+import Data.Haskell.Parser
11+import Data.List hiding (head, unlines)
12+import qualified Data.Text as T
1213import Relude
13−
14−import Data.List hiding (unlines)
1514import System.Directory.Tree
16−import Data.Haskell.Parser
1715
1816getFiles :: FilePath -> IO [FilePath]
1917getFiles dir = do
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 _ = []
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 _ = []
2628
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
3330processFile extensions file =
34− (unlines . fmap wrapExtension) extensions
31+ extensions
3532 <> "\n"
3633 <> withoutExtensions file
37− where
38− wrapExtension :: Text -> Text
39− wrapExtension e = "{-# LANGUAGE " <> e <> " #-}"
4034
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
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
src/Data/Haskell/Parser.hs+4−8
@@ -1,22 +1,18 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE TypeApplications #-}
4−{-# LANGUAGE DeriveGeneric #-}
5−{-# LANGUAGE DeriveAnyClass #-}
6−{-# LANGUAGE RecordWildCards #-}
1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
73
84module Data.Haskell.Parser
95 ( withoutExtensions
106 , withoutExtensionsParser
117 ) where
128
13−import Relude hiding (some, many)
9+import Relude hiding (many, some)
1410
1511import 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
stack.yaml+12
@@ -64,3 +64,15 @@ 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+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 DeriveAnyClass, DeriveGeneric, LambdaCase, NoImplicitPrelude, OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TypeApplications #-}
73
84main :: IO ()
95main = putStrLn "Test suite not yet implemented"