ats-format 0.2.0.28 → 0.2.0.29
raw patch · 5 files changed
+154/−149 lines, 5 filesdep +megaparsecdep ~htoml-megaparsecsetup-changed
Dependencies added: megaparsec
Dependency ranges changed: htoml-megaparsec
Files
- Setup.hs +7/−5
- app/Main.hs +0/−138
- ats-format.cabal +8/−5
- man/atsfmt.1 +1/−1
- src/Main.hs +138/−0
Setup.hs view
@@ -1,9 +1,11 @@+import Data.Foldable (fold) import Distribution.CommandLine import Distribution.Simple+import System.FilePath main :: IO ()-main = mconcat [ setManpath- , writeManpages "man/atsfmt.1" "atsfmt.1"- , writeBashCompletions "atsfmt"- , defaultMain- ]+main = fold [ setManpath+ , writeManpages ("man" </> "atsfmt.1") "atsfmt.1"+ , writeBashCompletions "atsfmt"+ , defaultMain+ ]
− app/Main.hs
@@ -1,138 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module Main where--import Control.Arrow-import Control.Monad (unless, (<=<))-import Data.FileEmbed (embedStringFile)-import qualified Data.HashMap.Lazy as HM-import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))-import qualified Data.Text.IO as TIO-import Data.Version-import Language.ATS-import Options.Applicative-import Paths_ats_format-import System.Directory (doesFileExist)-import System.Exit (exitFailure)-import System.IO (hPutStr, stderr)-import System.Process (readCreateProcess, shell)-import Text.PrettyPrint.ANSI.Leijen (pretty)-import Text.Toml--- import Text.Toml.Types hiding (Parser)--data Program = Program { _path :: Maybe FilePath, _inplace :: Bool, _noConfig :: Bool, _defaultConfig :: Bool }--takeBlock :: String -> (String, String)-takeBlock ('%':'}':ys) = ("", ('%':) . ('}':) $ ys)-takeBlock (y:ys) = first (y:) $ takeBlock ys-takeBlock [] = ([], [])--rest :: String -> IO String-rest xs = (<> (snd $ takeBlock xs)) <$> printClang (fst $ takeBlock xs)--printClang :: String -> IO String-printClang = readCreateProcess (shell "clang-format")--processClang :: String -> IO String-processClang ('%':'{':'^':xs) = ('%':) . ('{':) . ('^':) <$> rest xs-processClang ('%':'{':'#':xs) = ('%':) . ('{':) . ('#':) <$> rest xs-processClang ('%':'{':'$':xs) = ('%':) . ('{':) . ('$':) <$> rest xs-processClang ('%':'{':xs) = ('%':) . ('{':) <$> rest xs-processClang (x:xs) = (x:) <$> processClang xs-processClang [] = pure []--file :: Parser Program-file = Program- <$> optional (argument str- (metavar "FILEPATH"- <> completer (bashCompleter "file -X '!*.*ats' -o plusdirs")- <> help "File path to ATS source."))- <*> switch- (short 'i'- <> help "Modify file in-place")- <*> switch- (long "no-config"- <> short 'o'- <> help "Ignore configuration file")- <*> switch- (long "default-config"- <> help "Generate default configuration file in the current directory")--versionInfo :: Parser (a -> a)-versionInfo = infoOption ("madlang version: " ++ showVersion version) (short 'V' <> long "version" <> help "Show version")--wrapper :: ParserInfo Program-wrapper = info (helper <*> versionInfo <*> file)- (fullDesc- <> progDesc "ATS source code formater. For more detailed help, see 'man atsfmt'"- <> header "ats-format - a source code formatter written in Haskell")--main :: IO ()-main = execParser wrapper >>= pick--printFail :: String -> IO a-printFail = pure exitFailure <=< hPutStr stderr--defaultConfig :: FilePath -> IO ()-defaultConfig = flip writeFile $(embedStringFile ".atsfmt.toml")--asFloat :: Node -> Maybe Float-asFloat (VFloat d) = Just (realToFrac d)-asFloat _ = Nothing--asInt :: Node -> Maybe Int-asInt (VInteger i) = Just (fromIntegral i)-asInt _ = Nothing--asBool :: Node -> Maybe Bool-asBool (VBoolean True) = Just True-asBool (VBoolean False) = Just False-asBool _ = Nothing--parseToml :: String -> IO (Float, Int, Bool)-parseToml p = do- f <- TIO.readFile p- case parseTomlDoc p f of- Right x -> pure . fromMaybe (0.6, 120, False) $ do- r <- asFloat =<< HM.lookup "ribbon" x- w <- asInt =<< HM.lookup "width" x- cf <- asBool =<< HM.lookup "clang-format" x- pure (r, w, cf)- Left e -> printFail $ parseErrorPretty e--printCustom :: Eq a => ATS a -> IO String-printCustom ats = do- let p = ".atsfmt.toml"- config <- doesFileExist p- if config then do- (r, w, cf) <- parseToml p- let t = printATSCustom r w ats- if cf then- processClang t- else- pure t- else- pure $ printATS ats--genErr :: Eq a => Bool -> Either ATSError (ATS a) -> IO ()-genErr b = either (printFail . show . pretty) (putStrLn <=< go)- where go = if not b then printCustom else pure . printATS--inplace :: FilePath -> (String -> IO String) -> IO ()-inplace p f = do- contents <- readFile p- newContents <- f contents- unless (null newContents) $- writeFile p newContents--fancyError :: Either ATSError (ATS a) -> IO (ATS a)-fancyError = either (printFail . show . pretty) pure--pick :: Program -> IO ()-pick (Program (Just p) False nc _) = (genErr nc . parse) =<< readFile p-pick (Program Nothing _ nc False) = (genErr nc . parse) =<< getContents-pick (Program Nothing _ _ True) = defaultConfig ".atsfmt.toml"-pick (Program (Just p) True True _) = inplace p (fmap ((<> "\n") . printATS) . fancyError . parse)-pick (Program (Just p) True _ _) = inplace p ((fmap (<> "\n") . printCustom <=< fancyError) . parse)
ats-format.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: ats-format-version: 0.2.0.28+version: 0.2.0.29 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2017-2018 Vanessa McHale@@ -12,8 +12,8 @@ category: Parser, Language, ATS, Development build-type: Custom extra-source-files:- .atsfmt.toml man/atsfmt.1+ .atsfmt.toml extra-doc-files: README.md source-repository head@@ -23,7 +23,8 @@ custom-setup setup-depends: base -any, Cabal -any,- cli-setup >=0.1.0.2+ cli-setup >=0.1.0.2,+ filepath -any flag static description:@@ -38,16 +39,18 @@ executable atsfmt main-is: Main.hs- hs-source-dirs: app+ hs-source-dirs: src other-modules: Paths_ats_format default-language: Haskell2010+ other-extensions: OverloadedStrings TemplateHaskell ghc-options: -Wall build-depends: base >=4.9 && <5, language-ats >=0.1.1.10, optparse-applicative -any,- htoml-megaparsec >=2.0.0.0,+ htoml-megaparsec >=2.1.0.0,+ megaparsec >=7.0.0, text -any, ansi-wl-pprint -any, directory -any,
man/atsfmt.1 view
@@ -1,4 +1,4 @@-.\" Automatically generated by Pandoc 2.2.1+.\" Automatically generated by Pandoc 2.2.3.2 .\" .TH "atsfmt (1)" "" "" "" "" .hy
+ src/Main.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Control.Arrow+import Control.Monad (unless, (<=<))+import Data.FileEmbed (embedStringFile)+import qualified Data.HashMap.Lazy as HM+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text.IO as TIO+import Data.Version+import Language.ATS+import Options.Applicative+import Paths_ats_format+import System.Directory (doesFileExist)+import System.Exit (exitFailure)+import System.IO (hPutStr, stderr)+import System.Process (readCreateProcess, shell)+import Text.Megaparsec (errorBundlePretty)+import Text.PrettyPrint.ANSI.Leijen (pretty)+import Text.Toml++data Program = Program { _path :: Maybe FilePath, _inplace :: Bool, _noConfig :: Bool, _defaultConfig :: Bool }++takeBlock :: String -> (String, String)+takeBlock ('%':'}':ys) = ("", ('%':) . ('}':) $ ys)+takeBlock (y:ys) = first (y:) $ takeBlock ys+takeBlock [] = ([], [])++rest :: String -> IO String+rest xs = (<> (snd $ takeBlock xs)) <$> printClang (fst $ takeBlock xs)++printClang :: String -> IO String+printClang = readCreateProcess (shell "clang-format")++processClang :: String -> IO String+processClang ('%':'{':'^':xs) = ('%':) . ('{':) . ('^':) <$> rest xs+processClang ('%':'{':'#':xs) = ('%':) . ('{':) . ('#':) <$> rest xs+processClang ('%':'{':'$':xs) = ('%':) . ('{':) . ('$':) <$> rest xs+processClang ('%':'{':xs) = ('%':) . ('{':) <$> rest xs+processClang (x:xs) = (x:) <$> processClang xs+processClang [] = pure []++file :: Parser Program+file = Program+ <$> optional (argument str+ (metavar "FILEPATH"+ <> completer (bashCompleter "file -X '!*.*ats' -o plusdirs")+ <> help "File path to ATS source."))+ <*> switch+ (short 'i'+ <> help "Modify file in-place")+ <*> switch+ (long "no-config"+ <> short 'o'+ <> help "Ignore configuration file")+ <*> switch+ (long "default-config"+ <> help "Generate default configuration file in the current directory")++versionInfo :: Parser (a -> a)+versionInfo = infoOption ("madlang version: " ++ showVersion version) (short 'V' <> long "version" <> help "Show version")++wrapper :: ParserInfo Program+wrapper = info (helper <*> versionInfo <*> file)+ (fullDesc+ <> progDesc "ATS source code formater. For more detailed help, see 'man atsfmt'"+ <> header "ats-format - a source code formatter written in Haskell")++main :: IO ()+main = execParser wrapper >>= pick++printFail :: String -> IO a+printFail = pure exitFailure <=< hPutStr stderr++defaultConfig :: FilePath -> IO ()+defaultConfig = flip writeFile $(embedStringFile ".atsfmt.toml")++asFloat :: Node -> Maybe Float+asFloat (VFloat d) = Just (realToFrac d)+asFloat _ = Nothing++asInt :: Node -> Maybe Int+asInt (VInteger i) = Just (fromIntegral i)+asInt _ = Nothing++asBool :: Node -> Maybe Bool+asBool (VBoolean True) = Just True+asBool (VBoolean False) = Just False+asBool _ = Nothing++parseToml :: String -> IO (Float, Int, Bool)+parseToml p = do+ f <- TIO.readFile p+ case parseTomlDoc p f of+ Right x -> pure . fromMaybe (0.6, 120, False) $ do+ r <- asFloat =<< HM.lookup "ribbon" x+ w <- asInt =<< HM.lookup "width" x+ cf <- asBool =<< HM.lookup "clang-format" x+ pure (r, w, cf)+ Left e -> printFail $ errorBundlePretty e++printCustom :: Eq a => ATS a -> IO String+printCustom ats = do+ let p = ".atsfmt.toml"+ config <- doesFileExist p+ if config then do+ (r, w, cf) <- parseToml p+ let t = printATSCustom r w ats+ if cf then+ processClang t+ else+ pure t+ else+ pure $ printATS ats++genErr :: Eq a => Bool -> Either ATSError (ATS a) -> IO ()+genErr b = either (printFail . show . pretty) (putStrLn <=< go)+ where go = if not b then printCustom else pure . printATS++inplace :: FilePath -> (String -> IO String) -> IO ()+inplace p f = do+ contents <- readFile p+ newContents <- f contents+ unless (null newContents) $+ writeFile p newContents++fancyError :: Either ATSError (ATS a) -> IO (ATS a)+fancyError = either (printFail . show . pretty) pure++pick :: Program -> IO ()+pick (Program (Just p) False nc _) = (genErr nc . parse) =<< readFile p+pick (Program Nothing _ nc False) = (genErr nc . parse) =<< getContents+pick (Program Nothing _ _ True) = defaultConfig ".atsfmt.toml"+pick (Program (Just p) True True _) = inplace p (fmap ((<> "\n") . printATS) . fancyError . parse)+pick (Program (Just p) True _ _) = inplace p ((fmap (<> "\n") . printCustom <=< fancyError) . parse)