misfortune 0.1 → 0.1.1.1

raw patch · 7 files changed

+95/−108 lines, 7 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +0/−2
• misfortune.cabal +1/−1
• src/Data/Fortune.hs +11/−14
• src/Data/Fortune/FortuneFile.hs +17/−15
• src/Data/Fortune/Index.hs +0/−3
• src/Fortune.hs +65/−72
• src/StrFile.hs +1/−1

@@ -14,8 +14,6 @@      misfortune-strfile path/to/file -Note that `misfortune` uses a different format for its index files than `fortune` does.  If there is an existing fortune-mod index file, it will not be overwritten.- To use the fortune API in your Haskell programs:      import Data.Fortune

@@ -1,5 +1,5 @@ name:                   misfortune-version:                0.1+version:                0.1.1.1 stability:              experimental  cabal-version:          >= 1.6

@@ -226,7 +226,7 @@         then return "Very few profundities can be expressed in less than 80 characters."         else randomFortune paths -randomFortune paths = withFortuneFiles paths '%' False $ \fs -> do+randomFortune paths = withFortuneFiles '%' False paths $ \fs -> do     randomFortuneFromRandomFile . rvar =<< defaultFortuneDistribution fs  -- |Select a random fortune file from a specified distribution and then select a@@ -250,9 +250,6 @@     | f <- fs     ] --- TODO: allow the filter to assign a weight to each fortune, then weight the files--- by the total weight in their fortune-distributions (discarding zeros at both levels).- -- |Like 'defaultFortuneDistribution', but filtering the fortunes.  In addition to the -- fortune file, the tuples in the distribution include a distribution over the -- matching fortune indices in that file, assigning equal weight to each.@@ -270,19 +267,19 @@         ]  -- |Perform an action with an open 'FortuneFile', ensuring the file is closed--- when the action exits.-withFortuneFile :: FilePath -> Char -> Bool -> (FortuneFile -> IO a) -> IO a-withFortuneFile path delim writeMode = -    bracket (openFortuneFile path delim writeMode)+-- when the action finishes.+withFortuneFile :: Char -> Bool -> FilePath -> (FortuneFile -> IO a) -> IO a+withFortuneFile delim writeMode path = +    bracket (openFortuneFile delim writeMode path)              closeFortuneFile  -- |Perform an action with many open 'FortuneFile's, ensuring the files are closed--- when the action exits.-withFortuneFiles :: [FilePath] -> Char -> Bool -> ([FortuneFile] -> IO a) -> IO a-withFortuneFiles [] _ _ action = action []-withFortuneFiles (p:ps) delim writeMode action =-    withFortuneFile  p  delim writeMode $ \p ->-        withFortuneFiles ps delim writeMode $ \ps ->+-- when the action finishes.+withFortuneFiles :: Char -> Bool -> [FilePath] -> ([FortuneFile] -> IO a) -> IO a+withFortuneFiles _ _ [] action = action []+withFortuneFiles delim writeMode (p:ps) action =+    withFortuneFile delim writeMode p $ \p ->+        withFortuneFiles delim writeMode ps $ \ps ->             action (p:ps)  mapFortunesWithIndexM p f = 

@@ -1,4 +1,6 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-} module Data.Fortune.FortuneFile      ( FortuneFile      , fortuneFilePath@@ -52,21 +54,15 @@ -- using @delim@ as the character between strings, allowing writing if -- @writeMode@ is set.  If no file exists at the specified path, an error -- will be thrown or the file will be created, depending on @writeMode@.-openFortuneFile :: FilePath -> Char -> Bool -> IO FortuneFile-openFortuneFile path delim writeMode = do-    exists <- doesFileExist path-    when (not (exists || writeMode))-        (fail ("openFortuneFile: file does not exist: " ++ show path))+openFortuneFile :: Char -> Bool -> FilePath -> IO FortuneFile+openFortuneFile fortuneDelim fortuneWritable fortunePath = do+    exists <- doesFileExist fortunePath+    when (not (exists || fortuneWritable))+        (fail ("openFortuneFile: file does not exist: " ++ show fortunePath))     -    fileRef <- newMVar Nothing-    ixRef   <- newMVar Nothing-    return FortuneFile-        { fortunePath       = path-        , fortuneDelim      = delim-        , fortuneWritable   = writeMode-        , fortuneFile       = fileRef-        , fortuneIndex      = ixRef-        }+    fortuneFile  <- newMVar Nothing+    fortuneIndex <- newMVar Nothing+    return FortuneFile{..}  -- |Close a fortune file. Subsequent accesses will fail. closeFortuneFile :: FortuneFile -> IO ()@@ -167,6 +163,9 @@          return getOne +-- try to decode the first UTF-8 char in a buffer.  If the decoding fails +-- (returns replacement_char), then check if the whole buffer was used.+-- if it was, we probably just need more data so return Nothing. tryDecode bs = case U.decode bs of     Just (c, n)         | c /= U.replacement_char || n /= BS.length bs@@ -226,10 +225,14 @@          return nextFortune +#if !MIN_VERSION_base(4,6,0)+ modifyIORef' r f = do     x <- readIORef r     writeIORef r $! f x +#endif+ getByIndex file (IndexEntry loc len _ _) = do     hSeek file AbsoluteSeek (toInteger loc)     BS.hGet file len@@ -262,7 +265,6 @@ -- needed and updating the index. appendFortune :: FortuneFile -> T.Text -> IO () appendFortune f fortune = do-    -- TODO: detect whether a reindex is actually needed     rebuildIndex f     withFileAndIndex f $ \file ix -> do         offset <- max 0 . getMax . offsetAfter <$> getStats ix

@@ -214,7 +214,6 @@ checkIndex (Index file hdrRef) =     either Just id <$> try (withMVar hdrRef (checkIndex_ file)) --- TODO: also random spot-check for validity of table entries (mostly that they are consistent with the stats). checkIndex_ file hdr =     case checkHeader hdr of         Just problem -> return (Just (HeaderProblem problem))@@ -232,7 +231,6 @@         count = numFortunes (stats hdr)      res <- action file base (getSum count)     -    -- TODO: build flag to control paranoia level?     checkIndex_ file hdr >>= maybe (return res) throwIO      @@ -243,7 +241,6 @@         hSeek file AbsoluteSeek 0         BS.hPut file (runPut (putHeader newHdr))     -    -- TODO: build flag to control paranoia level?     checkIndex_ file newHdr >>= maybe (return newHdr) throwIO  -- |Get some cached stats about the fortunes indexed in this file.

@@ -81,17 +81,20 @@  data Length = Short | Long -type FortuneFilter = FortuneFile -> Int -> IndexEntry -> IO Bool+type FortuneFilter = FortuneFile -> Maybe (Int, IndexEntry) -> IO Bool  data Args = Args     { equalProb         :: Bool     , printDist         :: Bool     , dumpFortunes      :: Maybe FilePath     , fortuneFilters    :: [FortuneFilter]-    , threshold         :: Threshold     , fortuneFiles      :: [FortuneFile]     } +-- run all configured filters for an individual fortune+filterFile    args file     = andM [p file Nothing       | p <- fortuneFilters args]+filterFortune args file i e = andM [p file (Just (i, e)) | p <- fortuneFilters args]+ parseArgs = do     (opts, files, errors) <- getOpt Permute flags <$> getArgs     when (not (null errors))       (usage errors)@@ -105,21 +108,6 @@          when (Path `elem` opts) (printPath fortuneType)     -    let threshold = fromMaybe defaultThreshold (listToMaybe (opts >>= f))-            where f (LL n) = [Lines n]; f (N  n) = [Chars n]; f _ = []-        -        filterLength len _ _ e = return (checkThreshold threshold len (indexEntryStats e))-        filterRegex   rx f i _ = matchTest rx . T.unpack <$> getFortune f i-        -        mkRegex :: String -> Regex-        mkRegex = makeRegexOpts (compUTF8 + caseOpt) execBlank-            where caseOpt = if I `elem` opts then compCaseless else 0-        -        mkFilter L      = Just (filterLength Long)-        mkFilter S      = Just (filterLength Short)-        mkFilter (M rx) = Just (filterRegex (mkRegex rx))-        mkFilter _      = Nothing-         fortuneFiles <- if null files         then defaultFortuneFiles fortuneType         else do@@ -131,25 +119,46 @@                 else usage ["Fortune database not found: " ++ file | file <- missing]          -- open them all-    fortuneFiles <- mapM (\f -> openFortuneFile f '%' False) fortuneFiles-    -    -- pre-filter files based on stats in the headers.  saves time filtering fortunes.-    let lengthRestriction = listToMaybe (opts >>= f)-            where f L = [Long]; f S = [Short]; f _ = []-    fortuneFiles <- filterFortuneFiles threshold lengthRestriction fortuneFiles+    fortuneFiles <- mapM (openFortuneFile '%' False) fortuneFiles          return Args         { equalProb = E `elem` opts         , printDist = F `elem` opts         , dumpFortunes = listToMaybe [ path | D path <- opts ]-        , fortuneFilters = catMaybes (map mkFilter opts)+        , fortuneFilters = parseFilters opts         , ..         } -filterFortuneFiles threshold =-    maybe return-        (\r -> filterM (fmap (checkThreshold threshold r) . getStats <=< getIndex))+parseFilters opts = mapMaybe (parseFilter opts) opts+parseFilter opts opt = case opt of+    L      -> Just (filterLength Long)+    S      -> Just (filterLength Short)+    (M rx) -> Just (filterRegex (mkRegex rx))+    _      -> Nothing+    where+        filterLength len _ (Just (_, e)) = return (checkThreshold threshold len (indexEntryStats e))+        filterLength len f Nothing       = checkThreshold threshold len <$> (getStats =<< getIndex f)+        +        filterRegex   rx f (Just (i, _)) = matchTest rx . T.unpack <$> getFortune f i+        filterRegex   _  _ Nothing       = return True+        +        mkRegex :: String -> Regex+        mkRegex = makeRegexOpts (compUTF8 + caseOpt) execBlank+        +        caseOpt = if I `elem` opts then compCaseless else 0+        threshold = fromMaybe defaultThreshold (listToMaybe (opts >>= f))+        f (LL n) = [Lines n]; f (N  n) = [Chars n]; f _ = [] ++-- longest one is long+checkThreshold t Long  s =      overThreshold t (maxChars s) (maxLines s)+-- shortest one is not long+checkThreshold t Short s = not (overThreshold t (minChars s) (minLines s))++overThreshold (Chars n) c l = c > n+overThreshold (Lines n) c l = l > n++ -- find a fortune file... 2 main cases: -- 1) the path is a simple name (contains no /'s): --      first check the given search path.@@ -163,8 +172,14 @@ --           offensive one, because the user didn't say "-o". -- 2) the path is not a simple name (contains at least one /): --      Just check for the file.-resolve searchPath fullSearchPath file = case splitPath file of-    [_] -> do+resolve searchPath fullSearchPath file+    | any (`elem` pathSeparators) file = do+        exists <- doesFileExist file+        return $! if exists+            then Right [file]+            else Left file+    +    | otherwise = do         files <- findFortuneFileIn searchPath file         if null files             then do@@ -172,78 +187,56 @@                     then findFortuneFileIn fullSearchPath file                     else return []                 -                if null files-                    then return (Left file)-                    else return (Right files)+                return $! if null files+                    then Left file+                    else Right files                              else return (Right files)-    _ -> do-        exists <- doesFileExist file-        if exists-            then return (Right [file])-            else return (Left file)  main = do     args <- parseArgs-    let fortunes = fortuneFiles args+    -- pre-filter files that cannot possibly match.  saves time filtering fortunes.+    fortunes <- filterM (filterFile args) (fortuneFiles args)     +    dist <- getDist args fortunes+    +    when (numEvents dist == 0) $ do+        hPutStrLn stderr "No fortunes matched the filter criteria"+        exitWith (ExitFailure 2)+         case dumpFortunes args of         Nothing -> return ()         Just outPath -> do-            out <- openFortuneFile outPath '%' True+            out <- openFortuneFile '%' True outPath                          sequence_-                [ do-                    let allFilters i e = andM [p file i e | p <- fortuneFilters args]-                    selected <- filterFortunesWithIndexM allFilters file-                    sequence_-                        [ getFortune file i >>= appendFortune out-                        | i <- selected-                        ]-                | file <- fortunes+                [ getFortune file i >>= appendFortune out+                | (file, iDist) <- snd <$> toList dist+                , i             <- snd <$> toList iDist                 ]                          exitWith ExitSuccess     -    dist <- getDist args fortunes-    -    when (numEvents dist == 0) $ do-        hPutStrLn stderr "No fortunes matched the filter criteria"-        exitWith (ExitFailure 2)-         if printDist args         then sequence_-            -- TODO: merge paths into a tree for nicer presentation-            [ printf "%5d %8s: %s\n" n pctStr (fortuneFilePath file)-            | (weight, (file, n, _)) <- toList dist+            [ printf "%5d %8s: %s\n" (numEvents iDist) pctStr (fortuneFilePath file)+            | (weight, (file, iDist)) <- toList dist             , let pctStr = printf "(%.2f%%)" (100 * weight / totalWeight dist) :: String             ]         else do-            (file, _, fortuneDist) <- sample dist+            (file, fortuneDist) <- sample dist             fortune <- sample fortuneDist-            -- putStrLn (fortuneFilePath file ++ " - " ++ show fortune)             putStrLn . T.unpack =<< getFortune file fortune --- longest one is long-checkThreshold t Long  s =      overThreshold t (maxChars s) (maxLines s)--- shortest one is not long-checkThreshold t Short s = not (overThreshold t (minChars s) (minLines s))--overThreshold (Chars n) c l = c > n-overThreshold (Lines n) c l = l > n--getDist :: Args -> [FortuneFile] -> IO (Categorical Float (FortuneFile, Int, RVar Int))+getDist :: Args -> [FortuneFile] -> IO (Categorical Float (FortuneFile, Categorical Float Int)) getDist args files = equalize <$> case fortuneFilters args of     [] -> do         dist <- defaultFortuneDistribution files         let f file = do                 n <- getNumFortunes file-                return (file, n, uniform 0 (n-1))+                return (file, fromObservations [0 .. n-1])         T.mapM f dist-    filters -> do-        dist <- fortuneDistributionWhere (\f i e -> andM [p f i e | p <- filters]) files-        let f (file, iDist) = (file, numEvents iDist, rvar iDist)-        return (fmap f dist)+    _ -> fortuneDistributionWhere (filterFortune args) files     where          equalize             | equalProb args = mapCategoricalPs (const 1)

@@ -8,6 +8,6 @@     mapM_ index args  index file = do-    fortune <- openFortuneFile file '%' True+    fortune <- openFortuneFile '%' True file     rebuildIndex fortune