restyle (empty) → 0.1.0
raw patch · 8 files changed
+526/−0 lines, 8 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, utf8-string
Files
- Data/Transform/Camel.hs +61/−0
- Data/Transform/Separators.hs +34/−0
- Data/Transform/UnCamel.hs +113/−0
- Data/Transform/Utils.hs +44/−0
- LICENCE +7/−0
- Main.hs +232/−0
- Setup.hs +5/−0
- restyle.cabal +30/−0
+ Data/Transform/Camel.hs view
@@ -0,0 +1,61 @@+------------------------------------------------------------------------+-- |+-- Module : Data.Transform.Camel+-- Copyright : (c) 2010 Daniel Fischer+-- Licence : MIT+--+-- Maintainer : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability : experimental+-- Portability : portable+--+-- Transform separated_words identifiers to camelCase in Haskell source.+-- Based on Richard O\'Keefe\'s preprocessor hspp.+------------------------------------------------------------------------+module Data.Transform.Camel (camelSource) where++import Data.Char (isLower, isUpper, isAlpha, toUpper)+import Data.Transform.Utils++-- | Transform Haskell code written in separated_words style+-- to the more common camelCase style.+--+-- @camelSource sep source@ removes all occurences of @sep@+-- in identifiers in @source@ between two letters of which+-- the first is in lower case after processing and+-- transforms the second to upper case.+-- Thus @camelSource \'_\' \"a_b_c\" == \"aB_c\"@ since after+-- processing the first underscore, the second is no longer+-- preceded by a lowercase letter.+--+-- Comments (and 'String' literals) are not transformed, so+-- haddock comments may need manual fixing.+camelSource :: Char -> String -> String+camelSource = code++code :: Char -> String -> String+code s ('{':'-':cs) = '{' : '-' : nestedComment (code s) 1 cs+code s ('-':'-':cs)+ | null after = '-' : '-' : cs+ | isOpChar (head after) = '-' : '-' : dashes ++ code s after+ | otherwise = '-' : '-' : dashes ++ lineComment (code s) after+ where+ (dashes,after) = span (== '-') cs+code s (c:cs)+ | isOpChar c = c : syms ++ code s after+ where+ (syms,after) = span isOpChar cs+code s (c:'\'':cs)+ | isIdPlain c = c : '\'' : ids ++ code s after+ where+ (ids,after) = span isIdChar cs+code s ('"':cs) = '"' : string (code s) '"' cs+code s ('\'':cs) = '\'': string (code s) '\'' cs+code s (a:b:c:cs)+ | removeSep s a b c = a : toUpper c : code s cs+code s (c:cs) = c : code s cs+code _ _ = ""+++removeSep :: Char -> Char -> Char -> Char -> Bool+removeSep s a b c = isLower a && b == s && isAlpha c+
+ Data/Transform/Separators.hs view
@@ -0,0 +1,34 @@+----------------------------------------------------------------------+-- |+-- Module : Data.Transform.Separators+-- Copyright : (c) 2010 Daniel Fischer+-- Licence : MIT+--+-- Maintainer : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability : experimental+-- Portability : portable+--+-- Characters to visually separate words in compound identifiers.+----------------------------------------------------------------------+module Data.Transform.Separators ( -- * Separation Characters+ hyphen+ , lowLine+ , doubleLowLine+ , wideLowLine+ ) where++-- | Unicode hyphen, U+2010+hyphen :: Char+hyphen = '\x2010'++-- | Low line or underscore, U+005F+lowLine :: Char+lowLine = '\x5F'++-- | Double low line, U+2017+doubleLowLine :: Char+doubleLowLine = '\x2017'++-- | Wide low line, U+FF3F+wideLowLine :: Char+wideLowLine = '\xFF3F'
+ Data/Transform/UnCamel.hs view
@@ -0,0 +1,113 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Transform.UnCamel+-- Copyright : (c) 2010 Daniel Fischer+-- Licence : MIT+--+-- Maintainer : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability : experimental+-- Portability : portable+--+-- Transform camelCased identifiers to separated_words.+-----------------------------------------------------------------------------+module Data.Transform.UnCamel ( -- * Transformation Functions+ unCamelHTML+ , unCamelSource+ ) where++import Data.Char (isLower, isUpper, toLower)+import Data.Transform.Utils++-- | Transform identifiers in (haddock-produced) HTML files from+-- camelCase to separated_words.+--+-- The separation character is freely choosable, but it is+-- recommended to take one of those in "Transform.Separators". Since+-- underscore-separated identifiers are used in some+-- libraries, choosing 'lowLine' may lead to confusion.+--+-- The separation character is inserted between a lowercase+-- character and an uppercase character immediately following.+-- If that uppercase character is followed by a lowercase letter,+-- it is also transformed to lower case.+--+-- 'String' literals appearing in haddock comments are also+-- transformed. Deal with it or yell.+unCamelHTML :: Char -> String -> String+unCamelHTML r ('<':cs) = '<' : skipTag r cs+unCamelHTML r (a:b:c:cs)+ | hump a b c = a : r : toLower b : unCamelHTML r (c:cs)+unCamelHTML r (a:bs@(b:cs))+ | step a b = a : r : b : unCamelHTML r cs+ | otherwise = a : unCamelHTML r bs+unCamelHTML r cs = cs++hump :: Char -> Char -> Char -> Bool+hump a b c = isLower a && isUpper b && isLower c++step :: Char -> Char -> Bool+step a b = isLower a && isUpper b++skipTag :: Char -> String -> String+skipTag r ('>':cs) = '>' : unCamelHTML r cs+skipTag r (a:cs) = a : skipTag r cs+skipTag _ "" = ""++-- | Transform identifiers in (non-literate) source files from+-- camelCase to separated_words.+--+-- The separation character is freely choosable, but it is+-- recommended to take one of those in "Transform.Separators". Since+-- underscore-separated identifiers are used in some+-- libraries, choosing 'lowLine' may lead to confusion.+-- On the other hand, it is the only one which has a+-- fighting chance of producing valid Haskell code.+--+-- The separation character is inserted between a lowercase+-- character and an uppercase character immediately following.+-- If that uppercase charcter is followed by a lowercase letter,+-- it is also transformed to lower case.+--+-- Operators including two or more consecutive dashes are+-- handled correctly, i.e. @|--@ or @--:@ are not treated+-- as the start of a line-comment.+--+-- Single quotes in identifiers, as in @foldl'@ or @f'2''d@, are+-- not considered to begin a character literal. An unfortunate+-- consequence of that and the simple algorithm is that in an+-- expression like+--+-- > replicate 5'\\'+--+-- (with no space between number and character literal), the+-- closing quote is considered to begin a character literal.+--+-- Comments are not transformed, which may lead to inconsistencies+-- between code and comments. That may change in the future.+unCamelSource :: Char -> String -> String+unCamelSource = code++code :: Char -> String -> String+code r ('{':'-':cs) = '{' : '-' : nestedComment (code r) 1 cs+code r ('-':'-':cs)+ | null after = '-' : '-' : cs+ | isOpChar (head after) = '-' : '-' : dashes ++ code r after+ | otherwise = '-' : '-' : dashes ++ lineComment (code r) after+ where+ (dashes,after) = span (== '-') cs+code r (c:cs)+ | isOpChar c = c : syms ++ code r after+ where+ (syms,after) = span isOpChar cs+code r (c:'\'':cs)+ | isIdPlain c = c : '\'' : ids ++ code r after+ where+ (ids,after) = span isIdChar cs+code r ('"':cs) = '"' : string (code r) '"' cs+code r ('\'':cs) = '\'': string (code r) '\'' cs+code r (a:b:c:cs)+ | hump a b c = a : r : toLower b : code r (c:cs)+code r (a:bs@(b:cs))+ | step a b = a : r : b : code r cs+ | otherwise = a : code r bs+code r cs = cs
+ Data/Transform/Utils.hs view
@@ -0,0 +1,44 @@+----------------------------------------------------------------------+--+-- Module : Data.Transform.Utils+-- Copyright : (c) 2010 Daniel Fischer+-- Licence : MIT+--+-- Maintainer : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability : experimental+-- Portability : portable+--+-- Utility functions for the transformations.+----------------------------------------------------------------------+module Data.Transform.Utils where++import Data.Char+++isOpChar :: Char -> Bool+isOpChar c = c `notElem` "(),;[]`{}_'\"" && (isSymbol c || isPunctuation c)++isIdChar :: Char -> Bool+isIdChar c = c == '\'' || isIdPlain c++isIdPlain :: Char -> Bool+isIdPlain c = c == '_' || isAlphaNum c++nestedComment :: (String -> String) -> Integer -> String -> String+nestedComment cont 0 cs = cont cs+nestedComment cont l ('-':'}':cs) = '-' : '}' : nestedComment cont (l-1) cs+nestedComment cont l ('{':'-':cs) = '{' : '-' : nestedComment cont (l+1) cs+nestedComment cont l (c:cs) = c : nestedComment cont l cs+nestedComment _ _ _ = ""++lineComment :: (String -> String) -> String -> String+lineComment cont ('\n':cs) = '\n' : cont cs+lineComment cont (c:cs) = c : lineComment cont cs+lineComment _ _ = ""++string :: (String -> String) -> Char -> String -> String+string cont del ('\\':c:cs) = '\\' : c : string cont del cs+string cont del (c:cs)+ | c == del = c : cont cs+ | otherwise = c : string cont del cs+string _ _ _ = ""
+ LICENCE view
@@ -0,0 +1,7 @@+Copyright (c) 2010 Daniel Fischer++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,232 @@+----------------------------------------------------------------------+-- |+-- Module : Main+-- Copyright : (c) 2010 Daniel Fischer+-- Licence : MIT+--+-- Maintainer : Daniel Fischer <daniel.is.fischer@web.de>+-- Stability : experimental+-- Portability : portable+--+-- The executable to convert single files or entire directory trees+-- between camel case and separated words style.+----------------------------------------------------------------------+module Main (main) where++import System.Environment (getArgs)+import System.Console.GetOpt+import System.Directory+import System.FilePath+import qualified System.IO.UTF8 as S+import Data.Char (isAlphaNum)+import Data.Version+import Data.List+import Control.Monad (when)++import Data.Transform.Camel+import Data.Transform.UnCamel+import Data.Transform.Separators++main :: IO ()+main = do+ args <- getArgs+ case getWork args of+ Left str -> putStrLn str+ Right cf -> do+ let proc = worker cf+ shibboleth = case fileType cf of+ HTML -> (== ".html") . takeExtension+ HS -> (== ".hs") . takeExtension+ case input cf of+ Just (Left fn) -> let outfile = case output cf of+ Left ou -> ou+ Right d -> joinPath [d,fn]+ in do+ createDirectoryIfMissing True (takeDirectory outfile)+ transform proc fn outfile+ Just (Right dir) -> let look = case recursive cf of+ Just b -> b+ Nothing -> error "Insanity!!"+ odir = case output cf of+ Right d -> d+ in labour (transform proc) shibboleth look dir odir++labour :: (FilePath -> FilePath -> IO ()) -> (FilePath -> Bool) -> Bool -> FilePath -> FilePath -> IO ()+labour tf test more ind odir = do+ isd <- doesDirectoryExist ind+ when isd $ do+ createDirectoryIfMissing True odir+ conts <- getDirectoryContents ind+ (dirs,files) <- partitionDirs (ind </>) $ filter ((/= '.') . head) conts+ let rdirs+ | more = dirs+ | otherwise = []+ (wrk,cpy) = partition test files+ mapM_ (\fn -> tf (ind </> fn) (odir </> fn)) wrk+ mapM_ (\fn -> copyFile (ind </> fn) (odir </> fn)) cpy+ mapM_ (\dr -> labour tf test more (ind </> dr) (odir </> dr)) rdirs++transform :: (String -> String) -> FilePath -> FilePath -> IO ()+transform process infile outfile+ = S.readFile infile >>= S.writeFile outfile . process++partitionDirs :: (FilePath -> FilePath) -> [FilePath] -> IO ([FilePath],[FilePath])+partitionDirs jn = partDirs jn [] []++partDirs :: (FilePath -> FilePath) -> [FilePath] -> [FilePath] -> [FilePath] -> IO ([FilePath],[FilePath])+partDirs _ dirs files [] = return (dirs,files)+partDirs jn dirs files (fp : fps) = do+ isDir <- doesDirectoryExist (jn fp)+ if isDir+ then partDirs jn (fp:dirs) files fps+ else partDirs jn dirs (fp:files) fps++myVersion :: Version+myVersion = Version{ versionBranch = [0,1,0], versionTags = [] }++worker :: Config -> String -> String+worker cf = f s+ where+ s = case separator cf of+ Hyphen -> hyphen+ Under -> lowLine+ DoubleLow -> doubleLowLine+ WideLow -> wideLowLine+ Other c -> c+ f = case fileType cf of+ HTML -> unCamelHTML+ HS -> case target cf of+ Camel -> camelSource+ Sep -> unCamelSource++data Config+ = Conf+ { info :: Bool+ , version :: Bool+ , fileType :: FileType+ , target :: Target+ , separator :: Separator+ , recursive :: Maybe Bool+ , input :: Maybe (Either FilePath Directory)+ , output :: Either FilePath Directory+ }++defaultConf :: Config+defaultConf+ = Conf+ { info = False+ , version = False+ , fileType = HS+ , target = Sep+ , separator = Hyphen+ , recursive = Just True+ , input = Nothing+ , output = Right "Restyled"+ }++data FileType = HTML | HS+data Target = Camel | Sep+data Separator = Hyphen | Under | DoubleLow | WideLow | Other Char+type Directory = FilePath++sanitiseConfig :: Config -> Config+sanitiseConfig cf+ | insane cf = cf{ info = True }+ | otherwise = cf++insane :: Config -> Bool+insane cf+ | info cf || version cf = False+insane (Conf{ fileType = HTML, target = Camel }) = True+insane (Conf{ input = Nothing }) = True+insane (Conf{ input = Just (Left _), recursive = Just _ }) = True+insane (Conf{ fileType = HTML, input = Just (Left fn) })+ | takeExtension fn /= ".html" = True+insane (Conf{ fileType = HS, input = Just (Left fn) })+ | takeExtension fn /= ".hs" = True+insane cf@(Conf{ input = Just (Right _) }) = case output cf of+ Left _ -> True+ _ -> case recursive cf of+ Nothing -> True+ _ -> False+insane _ = False++options :: [OptDescr (Config -> Config)]+options =+ [ Option ['?','h'] ["help","usage","info"] (NoArg (\cf -> cf{ info = True }))+ "Print this message."+ , Option ['V'] ["version"] (NoArg (\cf -> cf{ version = True }))+ "Print version number and exit."+ , Option ['H'] ["HTML","html"] (NoArg (\cf -> cf{ fileType = HTML, target = Sep }))+ "UnCamel html file[s]"+{- , Option ['S'] ["source","hs","haskell"] (NoArg (\cf -> cf{ fileType = HS }))+ "Process Haskell source code (default)."+ , Option ['t'] ["target"] (ReqArg parseT "c[amel]|u[ncamel]|s[eparate_words]")+ "Target of transformation. Default is separate_words. Target camel doesn't work with HTML files." -}+ , Option ['c'] ["camel"] (NoArg (\cf -> cf{ fileType = HS, target = Camel }))+ "Transform source to camel case. Inconsistent with --html."+ , Option ['s'] ["sep","separator"] (ReqArg parseS "SEP")+ "Separation character to insert or remove (default is Unicode hyphen [U+2010], must not be alphanumeric)."+{- , Option ['h'] ["hyphen"] (NoArg (\cf -> cf{ separator = Hyphen }))+ "Hyphen as separation character (default)." -}+ , Option ['u'] ["underscore"] (NoArg (\cf -> cf{ separator = Under }))+ "Underscore as separation character."+ , Option ['d'] ["double"] (NoArg (\cf -> cf{ separator = DoubleLow }))+ "Double low line as separation character."+ , Option ['w'] ["wide"] (NoArg (\cf -> cf{ separator = WideLow }))+ "Wide low line as separation character."+{- , Option ['r'] ["rec"] (NoArg (\cf -> cf{ recursive = Just True }))+ "Transform directory contents recursively (default)." -}+ , Option ['n'] ["nonrec"] (NoArg (\cf -> cf{ recursive = Just False }))+ "Ignore subdirectories and only treat files in INDIR. Default is recursively processing subdirectories."+ , Option ['f'] ["file"] (ReqArg parseF "INFILE")+ "Transform only specified file, which must have a .hs or .html extension."+ , Option ['i','D'] ["indir","dir"] (ReqArg (\dr cf -> cf{ input = Just (Right dr) }) "INDIR")+ "Directory whose contents is to be transformed. Either this option or the file option is mandatory."+ , Option ['o'] ["out","odir"] (ReqArg (\dr cf -> cf{ output = Right dr }) "OUTDIR")+ "Directory in which to write processed files. This better be not INDIR and in case of recursive processing neither a subdirectory thereof. Default is 'Restyled'."+ , Option ['t'] ["ofile","outfile"] (ReqArg (\fn cf -> cf{ output = Left fn }) "OUTFILE")+ "Name of file to write (only if a single file is processed). Must be different from INFILE. Inconsistent with --odir."+ ]++parseT :: String -> Config -> Config+parseT str cf+ = case str of+ ('c':_) -> cf{ fileType = HS, target = Camel }+ ('u':_) -> cf{ target = Sep }+ ('s':_) -> cf{ target = Sep }+ _ -> cf{ info = True }++parseS :: String -> Config -> Config+parseS str cf+ = case str of+ (h:_) | not (isAlphaNum h) -> cf{ separator = Other h }+ _ -> cf{ info = True }++parseF :: String -> Config -> Config+parseF str cf+ = case takeExtension str of+ ext | ext == ".hs" -> cf{ fileType = HS, recursive = Nothing, input = Just (Left str) }+ | ext == ".html" -> cf{ fileType = HTML, target = Sep, recursive = Nothing, input = Just (Left str) }+ _ -> cf{ info = True }++generalUsage :: String+generalUsage = unlines+ [ "Usage: restyle OPTIONS"+ , "At least one of the options --help, --version, --indir=INDIR, --file=INFILE or their equivalents must be given."+ , "Unless otherwise specified, restyle converts Haskell source files from camel case to separated words."+ , "If an entire directory (hierarchy) shall be converted, files of other types are copied to the target location to create a working source or documentation tree with minimal effort."+ , "Conflicting options may be resolved in an arbitrary manner. If the order of the conflicting options doesn't lead to an automatic resolution, this message is displayed."+ ]++getWork :: [String] -> Either String Config+getWork args+ = case getOpt RequireOrder options args of+ (o,n,e)+ | null n && null e -> case foldl (flip id) defaultConf o of+ cf | info cf -> Left usage+ | version cf -> Left (showVersion myVersion)+ | otherwise -> Right cf+ | otherwise -> Left (concat e ++ unlines n ++ usage)+ where+ usage = usageInfo generalUsage options
+ Setup.hs view
@@ -0,0 +1,5 @@+module Main where++import Distribution.Simple++main = defaultMain
+ restyle.cabal view
@@ -0,0 +1,30 @@+Name: restyle+Version: 0.1.0+Cabal-version: >= 1.6+Build-type: Simple+License: MIT+License-file: LICENCE+Copyright: (c) 2010 Daniel Fischer+Author: Daniel Fischer+Maintainer: Daniel Fischer <daniel.is.fischer@web.de>+Stability: experimental+Synopsis: Convert between camel case and separated words style.+Description: Functions to transform Haskell source files and+ haddock(or HsColour)-produced HTML files from camel case+ to separated words or Haskell source from separated words+ to camel case.+Category: Development+Tested-With: GHC == 6.10.3, GHC == 6.12.1++Library+ Build-Depends: base >= 3 && < 5+ Exposed-Modules: Data.Transform.Camel, Data.Transform.UnCamel,+ Data.Transform.Separators+ Other-Modules: Data.Transform.Utils++Executable restyle+ Main-Is: Main.hs+ Build-Depends: base >= 3 && < 5, directory == 1.0.*,+ filepath == 1.1.*, utf8-string >= 0.3 && < 0.4+ Other-Modules: Data.Transform.Camel, Data.Transform.UnCamel,+ Data.Transform.Separators