setdown 0.1.2.0 → 0.1.3.0
raw patch · 10 files changed
+174/−77 lines, 10 filesdep +asyncdep +unixdep ~arraydep ~bytestringdep ~cmdargs
Dependencies added: async, unix
Dependency ranges changed: array, bytestring, cmdargs, containers, mtl, table-layout, text, uuid
Files
- setdown.cabal +16/−12
- src/DuplicateElimination.hs +4/−3
- src/ExternalSort.hs +3/−2
- src/Main.hs +58/−13
- src/PerformOperations.hs +11/−3
- src/PrintDefinition.hs +23/−12
- src/SetData.hs +1/−0
- src/SetInput.hs +4/−3
- src/SetLanguage.x +32/−14
- src/SetParser.y +22/−15
setdown.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.2.0+version: 0.1.3.0 -- A short (one-line) description of the package. synopsis: Treating files as sets to perform rapid set manipulation.@@ -42,7 +42,7 @@ -- A copyright notice. copyright: (c) 2015 Robert Massaioli --- category:+category: Data build-type: Simple @@ -82,19 +82,23 @@ -- Other library packages from which modules are imported. build-depends: base >=4.7 && < 5 -- Lexing dependencies- , array >= 0.5- , bytestring >= 0.10.4- , text >= 1.2+ , array >= 0.5 && < 0.6+ , bytestring >= 0.10 && < 0.13+ , text >= 1.2 && < 2.2 -- , pretty-show == 1.6.* -- Module Dependencies- , filepath >= 1.2 && < 3- , directory >= 1.1 && < 3- , containers >= 0.6- , uuid >= 1.3+ , filepath >= 1.2 && < 3+ , directory >= 1.1 && < 3+ , containers >= 0.6 && < 0.8+ , uuid >= 1.3 && < 1.4 , split == 0.2.*- , mtl >= 2.2- , cmdargs >= 0.10- , table-layout >= 0.8+ , mtl >= 2.2 && < 2.4+ , cmdargs >= 0.10 && < 0.11+ , table-layout >= 0.8 && < 1.1+ , async >= 2.2 && < 2.3++ if !os(windows)+ build-depends: unix >= 2.7 && < 2.9 build-tools: alex, happy
src/DuplicateElimination.hs view
@@ -69,6 +69,7 @@ orderExpression se@(SimpleBinaryExpression op left right) = if operatorIsCommutative op && right < left then SimpleBinaryExpression op right left else se operatorIsCommutative :: Operator -> Bool-operatorIsCommutative And = True-operatorIsCommutative Or = True-operatorIsCommutative Difference = False+operatorIsCommutative And = True+operatorIsCommutative Or = True+operatorIsCommutative Difference = False+operatorIsCommutative SymmetricDifference = True
src/ExternalSort.hs view
@@ -9,7 +9,8 @@ import Data.Maybe (catMaybes) import qualified Data.UUID.V4 as UUID import Data.List.Split (chunksOf)-import Control.Monad (forM)+import Control.Monad (forM)+import Control.Concurrent.Async (mapConcurrently) import System.FilePath ((</>)) import Control.Arrow (second) import qualified Data.Text.Lazy as T@@ -18,7 +19,7 @@ import Context extractAndSortFiles :: Context -> [FilePath] -> IO [(FilePath, FilePath)]-extractAndSortFiles ctx = mapM (extractAndSortFile ctx)+extractAndSortFiles ctx = mapConcurrently (extractAndSortFile ctx) extractAndSortFile :: Context -> FilePath -> IO (FilePath, FilePath) extractAndSortFile ctx fp = do
src/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Main where @@ -10,8 +11,9 @@ import System.Console.CmdArgs import System.Exit -import Control.Monad (filterM, forM_, unless)-import Control.Arrow (first)+import Control.Monad (filterM, forM, forM_, unless, when)+import Data.Word (Word8)+ import Data.List (intersperse, isSuffixOf, partition) import Data.Maybe (fromMaybe) @@ -29,9 +31,13 @@ import SimpleDefinitionCycles import System.Directory (doesFileExist, getCurrentDirectory,- listDirectory)+ listDirectory, removeFile) import System.FilePath (dropFileName, (</>)) +#ifndef mingw32_HOST_OS+import System.Posix.Files (createLink)+#endif+ -- Useful for Print Debugging -- import Text.Show.Pretty -- prettyPrint :: Show a => a -> IO ()@@ -154,7 +160,7 @@ mapM_ T.putStrLn xs exitWith (ExitFailure 12) - allFiles <- filesNotFound . S.toList . extractFilenamesFromDefinitions $ setData+ allFiles <- filesNotFound context . S.toList . extractFilenamesFromDefinitions $ setData unless (null allFiles) $ do putStrLn "[Error 13] the following files could not be found:" forM_ allFiles (\fp -> putStrLn $ " - " ++ fp)@@ -201,13 +207,39 @@ -- the file system. It would be great if we could print out the results of the computations as we -- go. computedFiles <- runSimpleDefinitions context simpleSetData sortedFiles- -- Step 3: Print out the final statistics with the defitions pointing to how many elements that+ -- Step 3: Publish retained results under their definition names.+ publishedFiles <- publishResults context computedFiles+ -- Step 4: Count the elements in each result file.+ annotatedFiles <- forM publishedFiles $ \(sd, fp) -> do+ n <- countLines fp+ return (sd, fp, n)+ -- Step 5: Print out the final statistics with the definitions pointing to how many elements that -- each contained and where to find their output files.- printComputedResults opts computedFiles+ printComputedResults opts annotatedFiles -filesNotFound :: [FilePath] -> IO [FilePath]-filesNotFound = filterM (\x -> not <$> doesFileExist x)+publishResults :: Context -> [(SimpleDefinition, FilePath)] -> IO [(SimpleDefinition, FilePath)]+#ifndef mingw32_HOST_OS+publishResults ctx results = mapM publish results+ where+ publish (sd, src)+ | sdRetain sd = do+ let dest = cOutputDir ctx </> LT.unpack (sdId sd) ++ ".txt"+ destExists <- doesFileExist dest+ when destExists $ removeFile dest+ createLink src dest+ return (sd, dest)+ | otherwise = return (sd, src)+#else+publishResults _ results = return results+#endif +countLines :: FilePath -> IO Int+countLines fp = fromIntegral . B.count newlineByte <$> B.readFile fp+ where newlineByte = 0x0A :: Word8++filesNotFound :: Context -> [FilePath] -> IO [FilePath]+filesNotFound ctx = filterM (\x -> not <$> doesFileExist (cBaseDir ctx </> x))+ printCycles :: [SimpleDefinitions] -> IO () printCycles sds = forM_ sds $ \sd -> do putStr " "@@ -246,19 +278,32 @@ rows = [Tab.rowsG $ fmap (\(from, to) -> [from, to]) fileMapping] -printComputedResults :: Options -> [(SimpleDefinition, FilePath)] -> IO ()+printTabularResultsWithCount :: [(String, FilePath, Int)] -> IO ()+printTabularResultsWithCount rows = sequence_ . fmap putStrLn $ Tab.tableLines (Tab.columnHeaderTableS columns Tab.unicodeBoldHeaderS headers tableRows)+ where+ headers = Tab.titlesH ["Name", "File", "Count"]++ columns =+ [ Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark+ , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark+ , Tab.column Tab.expand Tab.right Tab.noAlign Tab.noCutMark+ ]++ tableRows = [Tab.rowsG $ fmap (\(defName, fp, n) -> [defName, fp, show n]) rows]++printComputedResults :: Options -> [(SimpleDefinition, FilePath, Int)] -> IO () printComputedResults opts results = do unless (null tempResults || not (showTransient opts)) $ do putStrLn "Transient results:"- printTabularResults . fmap (first (LT.unpack . getIdentifier)) $ tempResults+ printTabularResultsWithCount . fmap toRow $ tempResults printNewline unless (null retainResults) $ do unless (not (showTransient opts)) $ putStrLn "Required results:"- printTabularResults . fmap (first (LT.unpack . getIdentifier)) $ retainResults+ printTabularResultsWithCount . fmap toRow $ retainResults where- (retainResults, tempResults) = partition (sdRetain . fst) results- --printResults = sequence_ . intersperse printNewline . fmap printComputedResult+ (retainResults, tempResults) = partition (\(sd, _, _) -> sdRetain sd) results getIdentifier (SimpleDefinition ident _ _) = ident+ toRow (sd, fp, n) = (LT.unpack (getIdentifier sd), fp, n) printComputedResult :: (SimpleDefinition, FilePath) -> IO ()
src/PerformOperations.hs view
@@ -109,9 +109,17 @@ } operatorTools :: Ord a => Operator -> OperatorTools a-operatorTools And = OT (==) const False False -- fst or snd, it does not matter they are equal-operatorTools Or = OT (const2 True) min True True-operatorTools Difference = OT (<) const True False+operatorTools And = OT (==) const False False -- fst or snd, it does not matter they are equal+operatorTools Or = OT (const2 True) min True True+operatorTools Difference = OT (<) const True False+-- Symmetric difference: OT (/=) min True True+-- Correctness: when l /= r, chosen = min l r.+-- l < r: emit l; dropWhileChosen advances left past l, leaves right unchanged (r > l). ✓+-- l > r: emit r; dropWhileChosen leaves left unchanged (l > r), advances right past r. ✓+-- l == r: otCompare is False → else-EQ branch: skip both, no emit. ✓+-- Remainders of either side: kept by otKeepRemainderLeft/Right = True. ✓+-- The else-LT and else-GT branches are unreachable since (/=) fires for both LT and GT.+operatorTools SymmetricDifference = OT (/=) min True True const2 :: a -> b -> c -> a const2 = const . const
src/PrintDefinition.hs view
@@ -1,21 +1,28 @@ module PrintDefinition ( printDefinitions , printDefinition- , printSimpleDefinitions + , printSimpleDefinitions , printSimpleDefinition ) where import SetData import Data.List (intersperse)+import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as T +maxAlignWidth :: Int+maxAlignWidth = 24+ -- Complex Definition Printing printDefinitions :: Definitions -> IO ()-printDefinitions = sequence_ . intersperse printNewline . fmap printDefinition +printDefinitions defs = sequence_ . intersperse printNewline $ fmap (printDefinition col) defs+ where+ col = min maxAlignWidth . maximum $ fmap (\(Definition i _) -> fromIntegral (TL.length i)) defs -printDefinition :: Definition -> IO ()-printDefinition (Definition ident expression) = do- printId ident+printDefinition :: Int -> Definition -> IO ()+printDefinition col (Definition ident expression) = do+ T.putStr ident+ putStr $ replicate (col - fromIntegral (TL.length ident)) ' ' putStr ": " printExpression expression printNewline@@ -35,11 +42,14 @@ -- Simple Definition Printing printSimpleDefinitions :: SimpleDefinitions -> IO ()-printSimpleDefinitions = sequence_ . intersperse printNewline . fmap printSimpleDefinition+printSimpleDefinitions defs = sequence_ . intersperse printNewline $ fmap (printSimpleDefinition col) defs+ where+ col = min maxAlignWidth . maximum $ fmap (\(SimpleDefinition i _ _) -> fromIntegral (TL.length i)) defs -printSimpleDefinition :: SimpleDefinition -> IO ()-printSimpleDefinition (SimpleDefinition ident se _) = do- printId ident+printSimpleDefinition :: Int -> SimpleDefinition -> IO ()+printSimpleDefinition col (SimpleDefinition ident se _) = do+ T.putStr ident+ putStr $ replicate (col - fromIntegral (TL.length ident)) ' ' putStr ": " printSimpleExpression se printNewline@@ -69,9 +79,10 @@ putStr ")" printOperator :: Operator -> IO ()-printOperator And = putStr "/\\"-printOperator Or = putStr "\\/"-printOperator Difference = putStr "-"+printOperator And = putStr "∩"+printOperator Or = putStr "∪"+printOperator Difference = putStr "-"+printOperator SymmetricDifference = putStr "△" printId :: Identifier -> IO () printId = T.putStr
src/SetData.hs view
@@ -23,6 +23,7 @@ = And | Or | Difference+ | SymmetricDifference deriving (Eq, Ord, Show) data Expression
src/SetInput.hs view
@@ -21,6 +21,7 @@ fromParserExpression (SP.IdentifierExp (SP.Identifier name)) = IdentifierExpression name fromParserOperator :: SP.SetOperator -> Operator-fromParserOperator SP.IntersectionOp = And-fromParserOperator SP.UnionOp = Or-fromParserOperator SP.DifferenceOp = Difference+fromParserOperator SP.IntersectionOp = And+fromParserOperator SP.UnionOp = Or+fromParserOperator SP.DifferenceOp = Difference+fromParserOperator SP.SymmetricDifferenceOp = SymmetricDifference
src/SetLanguage.x view
@@ -2,11 +2,12 @@ {-# OPTIONS_GHC -w #-} module SetLanguage where -import qualified Data.Text.Lazy as TL+import qualified Data.ByteString.Lazy as ByteString+import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE } -%wrapper "basic-bytestring"+%wrapper "posn-bytestring" $digit = [0-9] $nonFilename = [^\\\/\?\%\*\:\|\<\>\ ]@@ -16,20 +17,20 @@ $white+ ; "--".* ;- "(" { const LParenTok }- ")" { const RParenTok }- "/\" { const IntersectionTok }- "\/" { const UnionTok }- "∪" { const IntersectionTok }- "∩" { const UnionTok }- "-" { const DifferenceTok }- \"[^\"]+\" { FilenameTok . TL.unpack . TL.init . TL.tail . TLE.decodeUtf8 }- $ident+$white*":" { IdentifierDefinitionTok . TL.strip . TL.init . TLE.decodeUtf8 }- $ident+ { IdentifierTok . TLE.decodeUtf8 }+ "(" { tok LParenTok }+ ")" { tok RParenTok }+ "/\" { tok IntersectionTok }+ "\/" { tok UnionTok }+ "∪" { tok UnionTok }+ "∩" { tok IntersectionTok }+ "-" { tok DifferenceTok }+ "><" { tok SymmetricDifferenceTok }+ "△" { tok SymmetricDifferenceTok }+ \"[^\"]+\" { \pos bs -> LocatedToken pos (FilenameTok . TL.unpack . TL.init . TL.tail . TLE.decodeUtf8 $ bs) }+ $ident+$white*":" { \pos bs -> LocatedToken pos (IdentifierDefinitionTok . TL.strip . TL.init . TLE.decodeUtf8 $ bs) }+ $ident+ { \pos bs -> LocatedToken pos (IdentifierTok . TLE.decodeUtf8 $ bs) } {--- TODO include the location in which the token ocurred so that we can give better error messages--- later in the parsing data SetToken = FilenameTok FilePath | IdentifierDefinitionTok TL.Text@@ -39,5 +40,22 @@ | DifferenceTok | LParenTok | RParenTok+ | SymmetricDifferenceTok deriving(Show, Eq)++prettyToken :: SetToken -> String+prettyToken (FilenameTok fp) = "\"" ++ fp ++ "\""+prettyToken (IdentifierDefinitionTok name) = TL.unpack name ++ ":"+prettyToken (IdentifierTok name) = TL.unpack name+prettyToken IntersectionTok = "/\\"+prettyToken UnionTok = "\\/"+prettyToken DifferenceTok = "-"+prettyToken SymmetricDifferenceTok = "><"+prettyToken LParenTok = "("+prettyToken RParenTok = ")"++data LocatedToken = LocatedToken AlexPosn SetToken deriving (Show, Eq)++tok :: SetToken -> AlexPosn -> ByteString.ByteString -> LocatedToken+tok t pos _ = LocatedToken pos t }
src/SetParser.y view
@@ -4,22 +4,22 @@ import SetLanguage import qualified Data.Text.Lazy as TL -- TODO add precedence of operators--- TODO The tokens should come with line number information so that we can better pinpoint errors. } %name parseSetLanguage-%tokentype { SetToken }+%tokentype { LocatedToken } %error { parseError } %token- '(' { LParenTok }- ')' { RParenTok }- and { IntersectionTok }- or { UnionTok }- diff { DifferenceTok }- identifierDef { IdentifierDefinitionTok $$ }- identifier { IdentifierTok $$ }- filename { FilenameTok $$ }+ '(' { LocatedToken _ LParenTok }+ ')' { LocatedToken _ RParenTok }+ and { LocatedToken _ IntersectionTok }+ or { LocatedToken _ UnionTok }+ diff { LocatedToken _ DifferenceTok }+ symdiff { LocatedToken _ SymmetricDifferenceTok }+ identifierDef { LocatedToken _ (IdentifierDefinitionTok $$) }+ identifier { LocatedToken _ (IdentifierTok $$) }+ filename { LocatedToken _ (FilenameTok $$) } %% @@ -40,18 +40,25 @@ baseexp : filename { FilenameExp $1 } | identifier { IdentifierExp (Identifier $1) } -operator : and { IntersectionOp }- | or { UnionOp }- | diff { DifferenceOp }+operator : and { IntersectionOp }+ | or { UnionOp }+ | diff { DifferenceOp }+ | symdiff { SymmetricDifferenceOp } {-parseError :: [SetToken] -> a-parseError tokens = error $ "Parse error: " ++ show tokens+parseError :: [LocatedToken] -> a+parseError []+ = error "Parse error: unexpected end of input"+parseError (LocatedToken (AlexPn _ line col) t : _)+ = error $ "Parse error at line " ++ show line+ ++ ", column " ++ show col+ ++ ": unexpected \"" ++ prettyToken t ++ "\"" data SetOperator = IntersectionOp | UnionOp | DifferenceOp+ | SymmetricDifferenceOp deriving(Show, Eq) data Identifier = Identifier