setdown (empty) → 0.1.0.0

raw patch · 18 files changed

+1255/−0 lines, 18 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, cmdargs, containers, directory, filepath, mtl, split, text, uuid

Files

• Context.hs +35/−0
• DefinitionHelpers.hs +27/−0
• DuplicateElimination.hs +72/−0
• ExpressionConversion.hs +68/−0
• ExternalSort.hs +105/−0
• LICENSE +30/−0
• Main.hs +203/−0
• PerformOperations.hs +118/−0
• PrintDefinition.hs +85/−0
• README.markdown +153/−0
• SetData.hs +53/−0
• SetInput.hs +26/−0
• SetInputVerification.hs +30/−0
• SetLanguage.x +43/−0
• SetParser.y +70/−0
• Setup.hs +2/−0
• SimpleDefinitionCycles.hs +30/−0
• setdown.cabal +105/−0

@@ -0,0 +1,35 @@+module Context +   ( Context(..)+   , standardContext+   , smallContext+   , prepareContext+   , inOutput+   ) where++import Data.Int+import System.FilePath ((</>))+import System.Directory (createDirectoryIfMissing)++data Context = Context +   { cBaseDir :: FilePath+   , cOutputDir :: FilePath+   , cFilesPerMerge :: Int+   , cBytesPerFileSplit :: Int64+   } deriving (Show, Eq)++smallContext :: Context+smallContext = standardContext { cBytesPerFileSplit = 1000 }++standardContext :: Context+standardContext = Context+   { cBaseDir = "./"+   , cOutputDir = "output"+   , cFilesPerMerge = 10+   , cBytesPerFileSplit = 100 * 1024 * 1024+   }++prepareContext :: Context -> IO ()+prepareContext ctx = createDirectoryIfMissing True (cOutputDir ctx)++inOutput :: Context -> FilePath -> FilePath+inOutput ctx fp = cOutputDir ctx </> fp

@@ -0,0 +1,27 @@+module DefinitionHelpers +   ( extractIdsFromDefinitions +   , extractFilenamesFromDefinitions+   , extractDefinedIds+   ) where++import SetData+import qualified Data.Set as S++extractIdsFromExpression :: Expression -> S.Set Identifier+extractIdsFromExpression (BinaryExpression _ a b) = extractIdsFromExpression a `S.union` extractIdsFromExpression b+extractIdsFromExpression (FileExpression _) = S.empty+extractIdsFromExpression (IdentifierExpression i) = S.singleton i++extractIdsFromDefinitions :: Definitions -> S.Set Identifier+extractIdsFromDefinitions = foldr S.union S.empty . fmap (extractIdsFromExpression . definitionExpression)++extractFilenamesFromExpression :: Expression -> S.Set FilePath+extractFilenamesFromExpression (BinaryExpression _ a b) = extractFilenamesFromExpression a `S.union` extractFilenamesFromExpression b+extractFilenamesFromExpression (FileExpression fn) = S.singleton fn+extractFilenamesFromExpression (IdentifierExpression _) = S.empty++extractFilenamesFromDefinitions :: Definitions -> S.Set FilePath+extractFilenamesFromDefinitions = foldr S.union S.empty . fmap (extractFilenamesFromExpression . definitionExpression)++extractDefinedIds :: Definitions -> S.Set Identifier+extractDefinedIds = S.fromList . fmap definitionId

@@ -0,0 +1,72 @@+module DuplicateElimination +   ( eliminateDuplicates+   , orderDefinitions+   ) where++import SetData+import Data.Ord (comparing)+import Data.List (sort, sortBy, groupBy, partition)+import Data.Function (on)+import qualified Data.Set as S++eliminateDuplicates :: SimpleDefinitions -> SimpleDefinitions +eliminateDuplicates sds = sort . flip updateWithDuplicates sds $ findDuplicates sds++updateWithDuplicates :: [Duplicates] -> SimpleDefinitions -> SimpleDefinitions+updateWithDuplicates ds sds = S.toList $ foldr updateWithDuplicate (S.fromList sds) ds++-- TODO we now want to find all of the duplicates+-- There are three scenarios that we need to consider:+-- 0 Retain dupes: we can randomly select a node to be the remainder and replace references to the+-- rest+-- 1 Retain dupes: we select the retain dupe and point all of the other dupes to it+-- 2+ Retain dupes: we select a retain dupe and point the other retain dupes to it and replace all+-- of the other dupes with it+updateWithDuplicate :: Duplicates -> S.Set SimpleDefinition -> S.Set SimpleDefinition+updateWithDuplicate (Duplicates [] []) sds = sds+updateWithDuplicate dupes sds = S.insert retainDupe cleanedDefs+   where+      cleanedDefs = S.map (replaceIds newId oldIds) remainingDefs+      remainingDefs = sds S.\\ S.fromList discardDupes+      newId = sdId retainDupe+      oldIds = S.fromList . fmap sdId $ discardDupes+      (retainDupe : discardDupes) = dupRetain dupes ++ dupDiscontinue dupes++replaceIds :: Identifier -> S.Set Identifier -> SimpleDefinition -> SimpleDefinition+replaceIds newId oldIds (SimpleDefinition ident expr retain) = SimpleDefinition ident (replaceIdsInExpression newId oldIds expr) retain++replaceIdsInExpression :: Identifier -> S.Set Identifier -> SimpleExpression -> SimpleExpression+replaceIdsInExpression newId oldIds (SimpleUnaryExpression be) = SimpleUnaryExpression (replaceIdsInBaseExpression newId oldIds be)+replaceIdsInExpression newId oldIds (SimpleBinaryExpression op left right) = SimpleBinaryExpression op (replace left) (replace right)+   where+      replace = replaceIdsInBaseExpression newId oldIds++replaceIdsInBaseExpression :: Identifier -> S.Set Identifier -> BaseExpression -> BaseExpression+replaceIdsInBaseExpression _ _ be@(BaseFileExpression {}) = be+replaceIdsInBaseExpression newId oldIds be@(BaseIdentifierExpression ident) = if ident `S.member` oldIds then BaseIdentifierExpression newId else be++findDuplicates :: SimpleDefinitions -> [Duplicates]+findDuplicates = fmap toDuplicates . filter (\x -> length x > 1) . groupBy ((==) `on` sdExpression) ++toDuplicates :: SimpleDefinitions -> Duplicates+toDuplicates = uncurry Duplicates . partition sdRetain++data Duplicates = Duplicates+   { dupRetain :: SimpleDefinitions+   , dupDiscontinue :: SimpleDefinitions+   } deriving (Show)++orderDefinitions :: SimpleDefinitions -> SimpleDefinitions+orderDefinitions = sortBy (comparing sdExpression) . fmap orderDefinition++orderDefinition :: SimpleDefinition -> SimpleDefinition +orderDefinition sd = sd { sdExpression = orderExpression . sdExpression $ sd }++orderExpression :: SimpleExpression -> SimpleExpression+orderExpression se@(SimpleUnaryExpression {}) = se+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

@@ -0,0 +1,68 @@+module ExpressionConversion +   ( complexToSimpleDefinitions+   ) where++import SetData+import DefinitionHelpers+import Control.Monad.State+import qualified Data.Text.Lazy as T+import Data.Maybe (catMaybes)+import qualified Data.Set as S++data TransitionState = TS+   { tsCount :: Integer+   , tsUsedIds :: S.Set Identifier+   } deriving (Show)++type ConvState = State TransitionState++complexToSimpleDefinitions :: Definitions -> SimpleDefinitions+complexToSimpleDefinitions defs = evalState (fromDefinitions defs) initialState+   where+      initialState = TS +         { tsCount = 0+         , tsUsedIds = extractDefinedIds defs+         }++fromDefinitions :: Definitions -> ConvState SimpleDefinitions+fromDefinitions defs = do +   definitions <- mapM fromDefinition defs+   return . concat $ definitions++fromDefinition :: Definition -> ConvState SimpleDefinitions+fromDefinition (Definition ident expression) = do +   (expr, conv) <- convertExpression expression+   return $ SimpleDefinition ident expr True : conv++convertExpression :: Expression -> ConvState (SimpleExpression, SimpleDefinitions)+convertExpression (IdentifierExpression ident) = return (SimpleUnaryExpression (BaseIdentifierExpression ident), [])+convertExpression (FileExpression filePath) = return (SimpleUnaryExpression (BaseFileExpression filePath), [])+convertExpression (BinaryExpression op left right) = do+   (leftExp, leftConv) <- convertExpression left+   (rightExp, rightConv) <- convertExpression right+   (leftBase, leftDef) <- defFromExpression leftExp+   (rightBase, rightDef) <- defFromExpression rightExp+   return (SimpleBinaryExpression op leftBase rightBase, catMaybes [leftDef, rightDef] ++ leftConv ++ rightConv)++defFromExpression :: SimpleExpression -> ConvState (BaseExpression, Maybe SimpleDefinition)+defFromExpression (SimpleUnaryExpression be) = return (be, Nothing)+defFromExpression se@(SimpleBinaryExpression {}) = do+   defId <- getIdThenIncrement+   let newDef = SimpleDefinition defId se False+   return (BaseIdentifierExpression defId, Just newDef)++getIdThenIncrement :: ConvState Identifier+getIdThenIncrement = do+   original <- get+   let (intId, ident) = head . filter (\x -> snd x `S.notMember` tsUsedIds original) . fmap withId . thisAndFurther . tsCount $ original+   put $ original { tsCount = intId + 1 }+   return ident++withId :: Integer -> (Integer, Identifier)+withId x = (x, integerToId x)++thisAndFurther :: Integer -> [Integer]+thisAndFurther = iterate (+1)++integerToId :: Integer -> Identifier+integerToId = T.pack . show

@@ -0,0 +1,105 @@+module ExternalSort +   ( extractAndSortFiles +   , extractAndSortFile +   , splitSortAndMerge+   ) where++import Data.List (sort, groupBy)+import Data.Int+import Data.Maybe (catMaybes)+import qualified Data.UUID.V4 as UUID+import Data.List.Split (chunksOf)+import Control.Monad (forM)+import System.FilePath ((</>))+import Control.Arrow (second)+import Control.Applicative+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as T++import Context++extractAndSortFiles :: Context -> [FilePath] -> IO [(FilePath, FilePath)]+extractAndSortFiles ctx = mapM (extractAndSortFile ctx)++extractAndSortFile :: Context -> FilePath -> IO (FilePath, FilePath)+extractAndSortFile ctx fp = do+   resultFile <- splitSortAndMerge ctx fp+   return (fp, resultFile)++splitSortAndMerge :: Context -> FilePath -> IO FilePath+splitSortAndMerge ctx fp = mergeFiles ctx =<< splitAndSort ctx fp++splitAndSort :: Context -> FilePath -> IO [FilePath]+splitAndSort ctx fp = do+   splits <- splitFile ctx fp+   mapM simpleFileSort splits++simpleFileSort :: FilePath -> IO FilePath+simpleFileSort fp = do +   T.writeFile sfp . T.unlines . sort . T.lines =<< T.readFile fp+   return sfp+   where+      sfp = fp ++ ".sorted"++accLines :: [T.Text] -> [(T.Text, Int64)]+accLines = go 0+   where+      go :: Int64 -> [T.Text] -> [(T.Text, Int64)]+      go _     []     = []+      go start (x:xs) = (x, start) : go (start + T.length x) xs++chunkGroup :: Integral a => a -> (b, a) -> (b, a)+chunkGroup size = second (`div` size)++sameChunk :: Eq b => (a, b) -> (a, b) -> Bool+sameChunk (_, a) (_, b) = a == b++splitFile :: Context -> FilePath -> IO [FilePath]+splitFile ctx inputFile = do+   contents <- T.readFile (withBaseDir ctx inputFile)+   -- TODO replace constants with the context+   let splitContents = fmap (T.unlines . fmap fst) . groupBy sameChunk . fmap (chunkGroup . cBytesPerFileSplit $ ctx) . accLines . T.lines $ contents+   let namesAndContents = zip names splitContents+   sequence_ . fmap (uncurry T.writeFile) $ namesAndContents+   return . fmap fst $ namesAndContents+   where+      names = map (\num -> cOutputDir ctx </> inputFile ++ "." ++ show num ++ ".split") [(1 :: Integer)..]++mergeFiles :: Context -> [FilePath] -> IO FilePath+mergeFiles _ [] = error "Tried to merge no files..."+mergeFiles _ [f] = return f -- TODO rename to something sensible+mergeFiles ctx fps = do+   let mergeFilepaths = chunksOf (cFilesPerMerge ctx) fps -- [[FilePath]]+   mergedFiles <- forM mergeFilepaths (directMergeFiles ctx)+   mergeFiles ctx mergedFiles++directMergeFiles :: Context -> [FilePath] -> IO FilePath+directMergeFiles ctx fps = do+   fileContents <- fmap T.lines <$> mapM T.readFile fps+   randomFilename <- fmap show UUID.nextRandom+   let newFile = cOutputDir ctx </> randomFilename+   writeFileLines newFile . merge $ fileContents+   return newFile++writeFileLines :: FilePath -> [T.Text] -> IO ()+writeFileLines f = T.writeFile f . T.unlines++merge :: [[T.Text]] -> [T.Text]+merge xs = case minHead xs of+   Nothing -> []+   Just x -> x : merge (remainders x xs)++remainders :: T.Text -> [[T.Text]] -> [[T.Text]]+remainders x = fmap (dropWhile (== x))++minHead :: [[T.Text]] -> Maybe T.Text+minHead fs = case catMaybes $ fmap safeHead fs of+   [] -> Nothing+   xs -> Just . minimum $ xs++safeHead :: [a] -> Maybe a+safeHead []    = Nothing+safeHead (x:_) = Just x++withBaseDir :: Context -> FilePath -> FilePath+withBaseDir ctx fp = cBaseDir ctx </> fp

@@ -0,0 +1,30 @@+Copyright (c) 2015, Robert Massaioli++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Robert Massaioli nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,203 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Main where++import System.Console.CmdArgs+import qualified Data.ByteString.Lazy as B+import qualified Data.Text.Lazy.IO as T+import qualified Data.Set as S+import System.Exit++import Control.Monad (unless, forM_, filterM)+import Data.List (intersperse, partition)+import Data.Maybe (fromMaybe)+import Control.Applicative++import SetData+import SetInput+import SetInputVerification+import Context+import ExternalSort+import PrintDefinition+import ExpressionConversion+import DefinitionHelpers++import DuplicateElimination+import PerformOperations+import SimpleDefinitionCycles++import System.Directory (doesFileExist)+import System.FilePath (dropFileName, (</>))++-- Useful for Print Debugging+-- import Text.Show.Pretty+-- prettyPrint :: Show a => a -> IO ()+-- prettyPrint = putStrLn . ppShow+++data Options = Options+   { outputDirectory :: Maybe FilePath+   , setdownFile :: FilePath+   } deriving (Show, Data, Typeable)++options :: Options+options = Options +   { outputDirectory = def +      &= explicit +      &= name "output" +      &= typDir +      &= help "The directory in which to place the output contents. Relative to your .setdown file." +      &= opt "output" +   , setdownFile = def+      &= typ "definitions.setdown"+      &= argPos 0+   }+   &= program "setdown"+   &= summary "setdown allows you to perform set operations on multiple files efficiently using an intuitive language."++-- TODO the setdownFile should be optional, at which point we should search the current directory+-- for one+main :: IO ()+main = do+   opts <- cmdArgs options++   let inputFilePath = setdownFile opts+   inputFileExists <- doesFileExist inputFilePath +   unless inputFileExists $ do+      putStrLn $ "Error: The given setdown file did not exist: " ++ inputFilePath+      exitWith (ExitFailure 1)++   -- Todo work out the parent directory of the setdown file+   putStrLn "==> Creating the environment..."+   let baseDir = dropFileName inputFilePath++   let context = standardContext +                  { cBaseDir = baseDir +                  , cOutputDir = baseDir </> fromMaybe "output" (outputDirectory opts)+                  }++   putStrLn $ "Base Directory: " ++ cBaseDir context+   putStrLn $ "Output Directory: " ++ cOutputDir context+   prepareContext context+   printNewline++   setData <- parse <$> (B.readFile . setdownFile $ opts)+   putStrLn "==> Parsed original definitions..."+   printDefinitions setData+   -- Step 0: Verify that the definitions are well defined and that the referenced files exist+   -- relative to the file that we pass in.+   printNewline++   putStrLn "==> Verification (Ensuring correctness in the set definitions file)"+   case duplicateDefinitionName setData of+      [] -> putStrLn "OK: No duplicate definitions found."+      xs -> do +         putStrLn "[Error 11] Duplicate definitions found:"+         mapM_ T.putStrLn xs+         exitWith (ExitFailure 11)++   case unknownIdentifier setData of+      [] -> putStrLn "OK: No unknown identifiers found."+      xs -> do+         putStrLn "[Error 12] Unknown identifiers used in the set descriptor file:"+         mapM_ T.putStrLn xs+         exitWith (ExitFailure 12)++   allFiles <- filesNotFound . S.toList . extractFilenamesFromDefinitions $ setData+   unless (null allFiles) $ do+      putStrLn "[Error 13] the following files could not be found:"+      forM_ allFiles (\fp -> putStrLn $ " - " ++ fp)+      exitWith (ExitFailure 13)+   putStrLn "OK: All files in the definitions could be found."+   printNewline++   putStr "==> Simplifying and eliminating duplicates from set definitions..."+   let simpleSetData = eliminateDuplicates . orderDefinitions . complexToSimpleDefinitions $ setData+   putStrLn "DONE:"+   printSimpleDefinitions simpleSetData+   printNewline++   putStr "==> Checking for cycles in the simplified definitions..."+   let cycles = getCyclesInSimpleDefinitions simpleSetData+   putStrLn "DONE:"+   unless (null cycles) $ do+      putStrLn "[Error 20] found cyclic dependencies in the definitions!"+      printNewline+      putStrLn "We found the following cycles:"+      printCycles cycles+      exitWith (ExitFailure 20)+   putStrLn "OK: No cycles were found in the definitions."+   printNewline++   putStrLn "==> Copying and Sorting all input files from the definitions..."+   -- Step 1: For every unique file, sort it (Use external sort for this purpose:+   -- https://hackage.haskell.org/package/external-sort-0.2/docs/Algorithms-ExternalSort.html add+   -- docs to that library if at all possible)+   -- TODO use file timestamps to not sort these big files more than once if possible+   sortedFiles <- extractAndSortFiles context (S.toList . extractFilenamesFromDefinitions $ setData) -- TODO use the simple set data here+   printSortResults sortedFiles+   printNewline++   putStrLn "==> Computing set operations between the files..."+   -- Step 2: Calculate the graph of everything that needs to be computed and compute things one at+   -- a time. Even make sure that you store the temporary results along the way. That way we can+   -- refer to them later if the same computation is made twice. We should certainly memoize with+   -- 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+   -- each contained and where to find their output files.+   printComputedResults computedFiles+   +filesNotFound :: [FilePath] -> IO [FilePath]+filesNotFound = filterM (\x -> not <$> doesFileExist x)++printCycles :: [SimpleDefinitions] -> IO ()+printCycles sds = forM_ sds $ \sd -> do+   putStr "   "+   printCycle sd+   printNewline++printCycle :: SimpleDefinitions -> IO ()+printCycle [] = putStrLn "Not a cycle."+printCycle (x:xs) = sequence_ . intersperse (putStr " -> ") $ printIdentifiers+   where+      printIdentifiers = fmap (printIdentifier . sdId) loopRound+      loopRound = [x] ++ xs ++ [x]++-- TODO use the box library to print these items in a nice tabulated way+printSortResults :: [(FilePath, FilePath)] -> IO ()+printSortResults = sequence_ . fmap printSortResult++printSortResult :: (FilePath, FilePath) -> IO ()+printSortResult (unsortedFile, sortedFile) = do+   putStr . wrapInQuotes $ unsortedFile+   putStr " (unsorted) => "+   putStr . wrapInQuotes $ sortedFile +   putStrLn " (sorted)"+   where+      wrapInQuotes x = "\"" ++ x ++ "\""++printComputedResults :: [(SimpleDefinition, FilePath)] -> IO ()+printComputedResults results = do+   unless (null tempResults) $ do+      putStrLn "Transient results:"+      printResults tempResults+      printNewline+   unless (null retainResults) $ do+      putStrLn "Required results:"+      printResults retainResults +   where+      (retainResults, tempResults) = partition (sdRetain . fst) results+      printResults = sequence_ . intersperse printNewline . fmap printComputedResult ++printComputedResult :: (SimpleDefinition, FilePath) -> IO ()+printComputedResult (SimpleDefinition ident _ _, fp) = do+   printIdentifier ident+   putStr ": "+   putStrLn fp++printIdentifier :: Identifier -> IO ()+printIdentifier = T.putStr++printNewline :: IO ()+printNewline = putStrLn ""

@@ -0,0 +1,118 @@+module PerformOperations (runSimpleDefinitions) where++import Control.Arrow (first)+import Control.Applicative+import Control.Monad.State.Lazy+import Context+import SetData+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as T+import qualified Data.Map as M+import qualified Data.UUID.V4 as UUID++data ComputeState = CS+   { expressionToFile :: M.Map BaseExpression FilePath+   , definitionMap :: M.Map Identifier SimpleDefinition+   , csContext :: Context+   }++runSimpleDefinitions :: Context -> SimpleDefinitions -> [(FilePath, FilePath)] -> IO [(SimpleDefinition, FilePath)]+runSimpleDefinitions context defs sortedFileMapping = fst <$> runStateT (computeSimpleDefinitions defs) cs+   where+      cs = CS+         { expressionToFile = setupExpressionsToFile sortedFileMapping +         , definitionMap = toDefinitionMap defs+         , csContext = context+         }+      +toDefinitionMap :: SimpleDefinitions -> M.Map Identifier SimpleDefinition+toDefinitionMap = M.fromList . fmap (\x -> (sdId x, x))++setupExpressionsToFile :: [(FilePath, FilePath)] -> M.Map BaseExpression FilePath+setupExpressionsToFile = M.fromList . fmap (first BaseFileExpression)++computeSimpleDefinitions :: SimpleDefinitions -> StateT ComputeState IO [(SimpleDefinition, FilePath)]+computeSimpleDefinitions = mapM csd+   where+      csd :: SimpleDefinition -> StateT ComputeState IO (SimpleDefinition, FilePath)+      csd sd = do+         resultFile <- computeSimpleDefinition sd+         return (sd, resultFile)++-- Always return the file that should be used for the next computation+computeSimpleDefinition :: SimpleDefinition -> StateT ComputeState IO FilePath+computeSimpleDefinition (SimpleDefinition ident (SimpleUnaryExpression be) _) = do+   newFile <- computeBaseExpression be+   mapIdToFile ident newFile+   return newFile+computeSimpleDefinition (SimpleDefinition ident (SimpleBinaryExpression op left right) _) = do+   leftFile <- computeBaseExpression left+   rightFile <- computeBaseExpression right+   ctx <- csContext <$> get+   resultFile <- lift $ fileSetOperation ctx op leftFile rightFile+   mapIdToFile ident resultFile+   return resultFile++computeBaseExpression :: BaseExpression -> StateT ComputeState IO FilePath+computeBaseExpression be@(BaseFileExpression fp) = do +   expressionMap <- expressionToFile <$> get+   case M.lookup be expressionMap of+      Just sortedFile -> return sortedFile+      Nothing -> fail $ "Could not find a sorted file for: " ++ fp+computeBaseExpression be@(BaseIdentifierExpression ident) = do+   cs <- get+   case M.lookup be (expressionToFile cs) of+      Just preComputedFile -> return preComputedFile+      Nothing -> case M.lookup ident (definitionMap cs) of+         Nothing -> fail $ "Could not find a definition for the identifier: " ++ T.unpack ident+         Just def -> computeSimpleDefinition def++mapIdToFile :: Monad a => Identifier -> FilePath -> StateT ComputeState a ()+mapIdToFile ident fp = modify (\currentState -> currentState+   { expressionToFile = M.insert (BaseIdentifierExpression ident) fp (expressionToFile currentState)+   })++fileSetOperation :: Context -> Operator -> FilePath -> FilePath -> IO FilePath+fileSetOperation ctx ot leftFp rightFp = do+   leftContents <- T.lines <$> T.readFile leftFp +   rightContents <- T.lines <$> T.readFile rightFp +   let mergedContents = linesSetOperation (operatorTools ot) leftContents rightContents +   randomFilename <- randomFilenameInOutput ctx+   T.writeFile randomFilename . T.unlines $ mergedContents+   return randomFilename+   +randomFilenameInOutput :: Context -> IO FilePath+randomFilenameInOutput ctx = inOutput ctx . show <$> UUID.nextRandom++linesSetOperation :: OperatorTools T.Text -> [T.Text] -> [T.Text] -> [T.Text]+linesSetOperation ot = go+   where +      go :: [T.Text] -> [T.Text] -> [T.Text]+      go [] [] = []+      go xs [] = if otKeepRemainderLeft ot then xs else []+      go [] xs = if otKeepRemainderRight ot then xs else []+      go left@(l:ls) right@(r:rs) = +         if (otCompare ot) l r +            then chosen : go (dropWhileChosen left) (dropWhileChosen right)+            else case compare l r of+               LT -> go ls   right+               EQ -> go ls   rs+               GT -> go left rs+         where+            chosen = (otChoose ot) l r+            dropWhileChosen = dropWhile (== chosen)+      +data (Eq a, Ord a) => OperatorTools a = OT+   { otCompare :: a -> a -> Bool+   , otChoose  :: a -> a -> a+   , otKeepRemainderLeft :: Bool+   , otKeepRemainderRight :: Bool+   } ++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 ++const2 :: a -> b -> c -> a+const2 = const . const

@@ -0,0 +1,85 @@+module PrintDefinition+   ( printDefinitions+   , printDefinition+   , printSimpleDefinitions +   , printSimpleDefinition+   ) where++import SetData+import Data.List (intersperse)+import qualified Data.Text.Lazy.IO as T++-- Complex Definition Printing+printDefinitions :: Definitions -> IO ()+printDefinitions = sequence_ . intersperse printNewline . fmap printDefinition ++printDefinition :: Definition -> IO ()+printDefinition (Definition ident expression) = do+   printId ident+   putStr ": "+   printExpression expression+   printNewline++printExpression :: Expression -> IO ()+printExpression (FileExpression fp) = putStr $ "\"" ++ fp ++ "\""+printExpression (IdentifierExpression ident) = printId ident+printExpression (BinaryExpression op left right) = do+   printSubExpression left+   putStr " "+   printOperator op+   putStr " "+   printSubExpression right+   where+      printSubExpression expr = maybeWrapInBrackets (isBinaryExpression expr) (printExpression expr)+++-- Simple Definition Printing+printSimpleDefinitions :: SimpleDefinitions -> IO ()+printSimpleDefinitions = sequence_ . intersperse printNewline . fmap printSimpleDefinition++printSimpleDefinition :: SimpleDefinition -> IO ()+printSimpleDefinition (SimpleDefinition ident se _) = do+   printId ident+   putStr ": "+   printSimpleExpression se+   printNewline++printSimpleExpression :: SimpleExpression -> IO ()+printSimpleExpression (SimpleUnaryExpression be) = printBaseExpression be+printSimpleExpression (SimpleBinaryExpression op left right) = do+   printBaseExpression left+   putStr " "+   printOperator op+   putStr " "+   printBaseExpression right++printBaseExpression :: BaseExpression -> IO ()+printBaseExpression (BaseIdentifierExpression ident) = printId ident+printBaseExpression (BaseFileExpression fp) = putStr $ "\"" ++ fp ++ "\""++-- Common Printing Code+maybeWrapInBrackets :: Bool -> IO () -> IO ()+maybeWrapInBrackets True  = wrapInBrackets+maybeWrapInBrackets False = id++wrapInBrackets :: IO () -> IO ()+wrapInBrackets printAction = do+   putStr "("+   printAction+   putStr ")"++printOperator :: Operator -> IO ()+printOperator And          = putStr "/\\"+printOperator Or           = putStr "\\/"+printOperator Difference   = putStr "-"++printId :: Identifier -> IO ()+printId = T.putStr++printNewline :: IO ()+printNewline = putStrLn ""++-- TODO Move this out to a utility class+isBinaryExpression :: Expression -> Bool+isBinaryExpression (BinaryExpression {}) = True+isBinaryExpression _ = False

@@ -0,0 +1,153 @@+# Setdown - Line based set manipulation++Author: [Robert Massaioli][6]  +Created in: 2015  ++## What is setdown and how does it work?++Setdown is a command line tool for line based set operations. To use setdown you write a "setdown+definitions file" often suffixed with **.setdown**. If you are familiar with [Make][3] then you can think+of this **.setdown** file much like a Makefile. Inside that file you write a number of+definitions of the form:++    definitionName: "file-1.txt" /\ "file-2.txt"++This line says that "definitionName" is a new set definition that is a label for the intersection of+"file-1.txt" and "file-2.txt". You can write more complicated expressions that this.++### Example Setdown Projects++You should read how setdown works in the sections below, however, if you wish to follow along by+using a few descriptions then you should [checkout the setdown-examples project][2] on BitBucket.++### Input Files++In setdown *each file is treated as a list of elements where each line+is an element*. You may have thought that each file would be treated as a Set of elements (no+duplicate lines). But I decided not to make this a requirement, this is because I don't assume that +you will give us sorted input with no duplicates or that it will be easy for you to do so. Instead+you can give us any file that you like and the first thing that setdown will do to those files is+sort them and remove duplicates; essentially turning them into sets.++Another important point is that of relativity: specifically, if have a **.setdown** file that+references the input file "some-elements.txt" and I run the setdown executable from a directory that+is not the same directory as the **.setdown** file then where will setdown look for the+some-elements.txt file? The answer is that we always look for files relative to the **.setdown**+file. That is where you wrote your definitions so the paths are relative to that. It was designed in+this way so that you could run setdown from anywhere in the directory tree and still get the same+result. It was an important design of setdown that you always get the same result every time that you run it. +Setdown has been designed to be current working directory invariant, as opposed to many+other command line programs. Please keep this in mind. ++### Set Operations and Precidence++In the setdown language there are a number of supported operators:++ - Intersection: /\+ - Union: \/+ - Difference: -++For example, they might be used in the following way:++    definition: (A - B) \/ (C /\ D)++You may be wondering what [operator precidence][1] the setdown language uses and the answer is:+there is no operator precidence at all, instead *you must clearly specify the precidence of nested+expressions with brackets*. This is very important because it will result in parsing errors+otherwise. To show you why I made this decision lets show you an example:++    -- Here is a simple expression+    def: A /\ B \/ C+    -- Now, should this be parsed as:+    defV1: (A /\ B) \/ C+    -- or as:+    defV2: A /\ (B \/ C)+    -- If you pretend that B is the empty set (E) then you can see that these expression evaluate+    -- completely differently. If we simplify them with that assumption then they become:+    defV1-bempty: E+    defV2-bempty: A /\ C++So as you can see, order of operations really matters for set operations. Because it is so critical+I decided to make the use of brackets mandatory. Sorry for the extra brackets but you will thank me+when you expressions come out exactly the way that you expect them to.++### Comments++In the setdown language you can add comments by writing a double-dash (--) and then writing the+comment till the end of the line. The following comments are valid:++    -- This is a definition for A, created because we wanted to do X+    A: "y.txt" - "z.txt"+    +    -- This is an example of a comment halfway through an expression+    B: (A \/ C) -- \/ D This is still a comment and \/ D never happens++You can use comments to leave messages for any people that might read your setdown definitions in+the future. It may help explain to them what you were trying to do.++### Writing your own definitions++In the setdown language you can write a definition in the following format:++     <definitionName>: <expression>++Where the definition name is the identifier that you give to that expression. An expression is the+application of set operations on identifiers or files. A practical example of what this looks like+should help cement what this means. Here is a valid setdown file: ++    -- A is the intersection of the file b-1.out and the set B+    A: "b-1.out" /\ B++    -- B is the union of the file a-1.out and a-2.out+    B: "a-1.out" \/ "a-2.out"++    -- C is the difference of the file b-1.out and the set B+    C: "b-1.out" - B++Usually, when you write these definitions you put them in a file that has a suffix of **.setdown**.+You can then feed this file into the setdown executable like so:++    setdown path/to/mydefinitions.setdown++For more information on the options that you can pass to the setdown executable try running++    setdown --help++And good luck!++## Building the code++To build the code for this project just have [Haskell installed][4] and [cabal][5] and then:++    cabal sandbox init+    cabal install++And that should have the code built on your machine. Then, if you modify the code, just use cabal run to run setdown:++    cabal run -- --help+    cabal run mydefinitions.setdown++That is all that there is to it! ++## Contributing to the setdown project++If you wish to contribute to the setdown project then please just:++ 1. Raise an issue with what you intend to fix / improve.+ 1. Wait for Robert Massioli to get back to you and give you the thumbs up. If you get Robert+    Massaioli's "merge approval" then that means that, if you write the code to Roberts satisfaction+    then it will be merged in.+ 1. Write the code.+ 1. Raise a PR and ask Robert Massaioli to review it. (Maybe iterate a bit to get it cleaned up)+ 1. Get it merged in.+ 1. Celebrate!++I would love to have contributions to the project and, even though it may look like a complicated+process just follow it because it is designed to make your life, and my life, easier. Cheers!++ [1]: http://en.wikipedia.org/wiki/Order_of_operations+ [2]: https://bitbucket.org/robertmassaioli/setdown-examples+ [3]: http://www.gnu.org/software/make/+ [4]: https://www.haskell.org/platform/+ [5]: https://www.haskell.org/cabal/+ [6]: https://robertmassaioli.wordpress.com/

@@ -0,0 +1,53 @@+module SetData +   ( Definitions+   , Definition(..)+   , Expression(..)+   , Operator(..)+   , Identifier+   , SimpleDefinitions+   , SimpleDefinition(..)+   , SimpleExpression(..)+   , BaseExpression(..)+   ) where++import qualified Data.Text.Lazy as TL++type Definitions = [Definition]++data Definition = Definition+   { definitionId :: Identifier+   , definitionExpression :: Expression+   } deriving (Eq, Show)++data Operator+   = And+   | Or+   | Difference+   deriving (Eq, Ord, Show)++data Expression+   = BinaryExpression Operator Expression Expression+   | FileExpression FilePath+   | IdentifierExpression Identifier+   deriving (Eq, Show)++type Identifier = TL.Text++type SimpleDefinitions = [SimpleDefinition]++data SimpleDefinition = SimpleDefinition+   { sdId :: Identifier+   , sdExpression :: SimpleExpression+   , sdRetain :: Bool -- This is true if this is a definition that must be maintained+   } deriving (Eq, Ord, Show)++data SimpleExpression +   = SimpleBinaryExpression Operator BaseExpression BaseExpression+   | SimpleUnaryExpression BaseExpression+   deriving (Eq, Ord, Show)++data BaseExpression+   = BaseFileExpression FilePath+   | BaseIdentifierExpression Identifier+   deriving (Eq, Ord, Show)+

@@ -0,0 +1,26 @@+module SetInput +   ( parse+   ) where++import SetData++import qualified Data.ByteString.Lazy as BL+import qualified SetLanguage as SL+import qualified SetParser as SP++parse :: BL.ByteString -> Definitions+parse = fmap fromParserDefinition . SP.parseSetLanguage . SL.alexScanTokens++fromParserDefinition :: SP.Definition -> Definition+fromParserDefinition (SP.Definition (SP.Identifier name) expression) = Definition name (fromParserExpression expression)++fromParserExpression :: SP.Expression -> Expression+fromParserExpression (SP.BinaryExp op a b) = BinaryExpression (fromParserOperator op) (fromParserExpression a) (fromParserExpression b)+fromParserExpression (SP.BrackExp a) = fromParserExpression a+fromParserExpression (SP.FilenameExp filename) = FileExpression filename+fromParserExpression (SP.IdentifierExp (SP.Identifier name)) = IdentifierExpression name++fromParserOperator :: SP.SetOperator -> Operator+fromParserOperator SP.IntersectionOp = And+fromParserOperator SP.UnionOp = Or+fromParserOperator SP.DifferenceOp = Difference

@@ -0,0 +1,30 @@+module SetInputVerification where ++import qualified Data.Text.Lazy as TL+import Data.List+import qualified Data.Set as S+import SetData+import DefinitionHelpers++-- TODO these functions should generate potential lists of error messages++duplicateDefinitionName :: Definitions -> [TL.Text]+duplicateDefinitionName defs = fmap message problems+   where+      message :: [Identifier] -> TL.Text+      message problem = TL.pack "Created multiple definitions for: " `TL.append` (TL.pack . show $ problem)++      problems = filter ((>1) . length) . group . sort . fmap definitionId $ defs++unknownIdentifier :: Definitions -> [TL.Text]+unknownIdentifier defs = fmap message (S.toList nonDefinedIds)+   where+      message :: Identifier -> TL.Text+      message problem = TL.pack "Attempted to use an identifier that has not been defined: " `TL.append` problem++      nonDefinedIds = usedIds S.\\ definitionIds+      usedIds = extractIdsFromDefinitions defs+      definitionIds = extractDefinedIds defs++-- TODO add a function that searches through the list of files in the definition and returns an+-- error for all of the files that do not exist

@@ -0,0 +1,43 @@+{+{-# OPTIONS_GHC -w #-}+module SetLanguage where++import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+}++%wrapper "basic-bytestring"++$digit = [0-9]+$nonFilename = [^\\\/\?\%\*\:\|\<\>\ ]+$ident = [a-zA-Z0-9\-\_]++tokens :-++   $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 }++{+-- 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+   | IdentifierTok TL.Text+   | IntersectionTok+   | UnionTok+   | DifferenceTok+   | LParenTok+   | RParenTok+   deriving(Show, Eq)+}

@@ -0,0 +1,70 @@+{+module SetParser where++import SetLanguage+import qualified Data.Text.Lazy as TL+-- TODO add precidence of operators+-- TODO add comments to the language+-- TODO The tokens should come with line number information so that we can better pinpoint errors.+}++%name parseSetLanguage+%tokentype { SetToken }+%error { parseError }++%token+   '('            { LParenTok }+   ')'            { RParenTok }+   and            { IntersectionTok }+   or             { UnionTok }+   diff           { DifferenceTok }+   identifierDef  { IdentifierDefinitionTok $$ }+   identifier     { IdentifierTok $$ }+   filename       { FilenameTok $$ }++%%++definitions : definition               { [$1] }+            | definitions definition   { $2 : $1 }++definition : identifierDef exp         { Definition (Identifier $1) $2 }++exp : baseexp                          { $1 }+    | brackexp                         { $1 }+    | baseorbrack operator baseorbrack { BinaryExp $2 $1 $3 }++baseorbrack : baseexp        { $1 }+            | brackexp       { $1 }++brackexp : '(' exp ')'       { BrackExp $2 }++baseexp : filename           { FilenameExp $1 }+        | identifier         { IdentifierExp (Identifier $1) }++operator : and    { IntersectionOp }+         | or     { UnionOp }+         | diff   { DifferenceOp }++{+parseError :: [SetToken] -> a+parseError tokens = error $ "Parse error: " ++ show tokens++data SetOperator +   = IntersectionOp+   | UnionOp+   | DifferenceOp+   deriving(Show, Eq)++data Identifier = Identifier+   { idName :: TL.Text+   } deriving(Show, Eq)++data Expression+   = BinaryExp SetOperator Expression Expression+   | BrackExp Expression+   | FilenameExp FilePath+   | IdentifierExp Identifier+   deriving(Show, Eq)++data Definition = Definition Identifier Expression deriving (Show, Eq)+}

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,30 @@+module SimpleDefinitionCycles +   ( getCyclesInSimpleDefinitions+   ) where++import SetData+import qualified Data.Graph as G++getCyclesInSimpleDefinitions :: SimpleDefinitions -> [SimpleDefinitions]+getCyclesInSimpleDefinitions = filter (not . null) . fmap getCycles . simpleDefinitionsToSCC ++getCycles :: G.SCC SimpleDefinition -> SimpleDefinitions+getCycles (G.CyclicSCC verticies) = verticies+getCycles _ = []++simpleDefinitionsToSCC :: SimpleDefinitions -> [G.SCC SimpleDefinition]+simpleDefinitionsToSCC = G.stronglyConnComp . fmap toNode++toNode :: SimpleDefinition -> (SimpleDefinition, Identifier, [Identifier])+toNode sd = (sd, sdId sd, getIdsFromSimpleDefinition sd)++getIdsFromSimpleDefinition :: SimpleDefinition -> [Identifier]+getIdsFromSimpleDefinition (SimpleDefinition _ expr _) = getIdsFromSimpleExpression expr++getIdsFromSimpleExpression :: SimpleExpression -> [Identifier]+getIdsFromSimpleExpression (SimpleBinaryExpression _ left right) = getIdsFromBaseExpression left ++ getIdsFromBaseExpression right+getIdsFromSimpleExpression (SimpleUnaryExpression expr) = getIdsFromBaseExpression expr++getIdsFromBaseExpression :: BaseExpression -> [Identifier]+getIdsFromBaseExpression (BaseIdentifierExpression ident) = [ident]+getIdsFromBaseExpression _ = []

@@ -0,0 +1,105 @@+-- Initial setdown.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                setdown++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            Treating files as sets to perform rapid set manipulation.++-- A longer description of the package.+description:         There will be times when you have lots of set data and you want to perform many+                     set operations quickly and reliably, you will also want to be able to add new+                     data to your set operations and be able to run the same set operations with +                     little effort. This is the problem that setdown aims to solve. Setdown was+                     built with the intention that you would use it in conjunction with version+                     control tools to manage your set data and set description file.++homepage:            http://bitbucket.org/robertmassaioli/setdown+bug-reports:         https://bitbucket.org/robertmassaioli/setdown/issues++-- The license under which the package is released.+license:             BSD3++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Robert Massaioli++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          robertmassaioli@gmail.com++-- A copyright notice.+copyright:           (c) 2015 Robert Massaioli++-- category:            ++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+extra-source-files:  README.markdown++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++source-repository head+   type: git+   location: git@bitbucket.org:robertmassaioli/setdown.git++executable setdown+  -- .hs or .lhs file containing the Main module.+  main-is:             Main.hs+  +  -- Modules included in this executable, other than Main.+  other-modules:       SetLanguage+                       , SetParser+                       , Context+                       , DefinitionHelpers+                       , DuplicateElimination+                       , ExpressionConversion+                       , ExternalSort+                       , Main+                       , PerformOperations+                       , PrintDefinition+                       , SetData+                       , SetInput+                       , SetInputVerification+                       , SimpleDefinitionCycles+  +  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:    +  +  -- Other library packages from which modules are imported.+  build-depends:       base            >=4.7 && <4.8+                       -- Lexing dependencies+                       , array         == 0.5.*+                       , bytestring    == 0.10.4.*+                       , text          == 1.2.*+                       -- , pretty-show == 1.6.*+                       -- Module Dependencies+                       , filepath      >= 1.2 && < 2+                       , directory     >= 1.1 && < 2+                       , containers    == 0.5.*+                       , uuid          == 1.3.*+                       , split         == 0.2.*+                       , mtl           == 2.2.*+                       , cmdargs       == 0.10.*+  +  -- Directories containing source files.+  -- hs-source-dirs:      +  +  -- Base language which the package is written in.+  default-language:    Haskell2010++  ghc-options: -Wall