Use Data.Text
authorJoachim Breitner <mail@joachim-breitner.de>
Sun, 21 Mar 2010 10:24:59 +0000 (10:24 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Sun, 21 Mar 2010 10:24:59 +0000 (10:24 +0000)
arbtt.cabal
src/Capture/X11.hs
src/Categorize.hs
src/Data.hs
src/Data/Binary/StringRef.hs
src/Stats.hs
src/UpgradeLog1.hs
src/stats-main.hs

index fe2dc2b..68e550f 100644 (file)
@@ -30,7 +30,7 @@ executable arbtt-capture
     main-is:            capture-main.hs
     hs-source-dirs:     src
     build-depends:
-        base == 4.*, filepath, directory, mtl, time, utf8-string,
+        base == 4.*, filepath, directory, mtl, time, utf8-string, text,
         bytestring, binary
     other-modules:
         Data
@@ -63,7 +63,7 @@ executable arbtt-stats
     main-is:            stats-main.hs
     hs-source-dirs:     src
     build-depends:
-        base == 4.*, parsec == 2.*, containers, pcre-light, old-locale
+        base == 4.*, parsec == 2.*, containers, pcre-light, old-locale, text
     other-modules:
         Data
         Data.Binary.StringRef
@@ -72,7 +72,7 @@ executable arbtt-stats
         TimeLog
         Stats
         Text.ParserCombinators.Parsec.ExprFail
-        Text.Regex.PCRE.Light.String
+        Text.Regex.PCRE.Light.Text
     if os(windows) 
         cpp-options:    -DWIN32
     else
@@ -99,7 +99,7 @@ executable arbtt-import
     main-is:            import-main.hs
     hs-source-dirs:     src
     build-depends:
-        base == 4.*, parsec == 2.*, containers
+        base == 4.*, parsec == 2.*, containers, text
     other-modules:
         Data
         Data.Binary.StringRef
@@ -115,7 +115,7 @@ executable arbtt-recover
     main-is:            recover-main.hs
     hs-source-dirs:     src
     build-depends:
-        base == 4.*, parsec == 2.*, containers
+        base == 4.*, parsec == 2.*, containers, text
     other-modules:
         Data
         Data.Binary.StringRef
index 80af45a..fff92a9 100644 (file)
@@ -9,6 +9,7 @@ import Control.Applicative
 import Data.Maybe
 import Data.Time.Clock
 import System.IO
+import qualified Data.Text as T
 
 import System.Locale.SetLocale
 import Graphics.X11.XScreenSaver (getXIdleTime, compiledWithXScreenSaver)
@@ -42,7 +43,10 @@ captureData = do
         (fsubwin,_) <- getInputFocus dpy
         fwin <- followTreeUntil dpy (`elem` wins) fsubwin
 
-        winData <- mapM (\w -> (,,) (w == fwin) <$> getWindowTitle dpy w <*> getProgramName dpy w) wins
+        winData <- forM wins $ \w -> (,,)
+            (w == fwin) <$>
+            (T.pack <$> getWindowTitle dpy w) <*>
+            (T.pack <$> getProgramName dpy w)
 
         it <- fromIntegral `fmap` getXIdleTime dpy
 
index 8047286..d977f92 100644 (file)
@@ -3,8 +3,10 @@ module Categorize where
 
 import Data
 
-import qualified Text.Regex.PCRE.Light.String as RE
+import qualified Text.Regex.PCRE.Light.Text as RE
 import qualified Data.Map as M
+import qualified Data.Text as T
+import Data.Text (Text)
 import Control.Monad
 import Control.Monad.Instances
 
@@ -36,24 +38,24 @@ data Ctx = Ctx
         { cNow :: TimeLogEntry CaptureData
         , cPast :: [TimeLogEntry CaptureData]
         , cFuture :: [TimeLogEntry CaptureData]
-        , cWindowInScope :: Maybe (Bool, String, String)
-        , cSubsts :: [String]
+        , cWindowInScope :: Maybe (Bool, Text, Text)
+        , cSubsts :: [Text]
         , cCurrentTime :: UTCTime
         , cTimeZone :: TimeZone
         }
   deriving (Show)
 
-type Cond = CtxFun [String]
+type Cond = CtxFun [Text]
 
 type CtxFun a = Ctx -> Maybe a
 
 data CondPrim
-        = CondString (CtxFun String)
+        = CondString (CtxFun Text)
         | CondRegex (CtxFun RE.Regex)
         | CondInteger (CtxFun Integer)
         | CondTime (CtxFun NominalDiffTime)
         | CondDate (CtxFun UTCTime)
-        | CondCond (CtxFun [String])
+        | CondCond (CtxFun [Text])
 
 newtype Cmp = Cmp (forall a. Ord a => a -> a -> Bool)
 
@@ -105,15 +107,15 @@ parseAliasSpecs :: Parser (ActivityData -> ActivityData)
 parseAliasSpecs = do as <- sepEndBy1 parseAliasSpec (comma lang)
                      return $ \ad -> foldr doAlias ad as
 
-doAlias :: (String, String) -> ActivityData -> ActivityData
+doAlias :: (Text, Text) -> ActivityData -> ActivityData
 doAlias (s1,s2) = map go
   where go (Activity cat tag) = Activity (if cat == Just s1 then Just s2 else cat)
                                          (if tag == s1 then s2 else tag)
 
-parseAliasSpec :: Parser (String, String)
-parseAliasSpec = do s1 <- stringLiteral lang
+parseAliasSpec :: Parser (Text, Text)
+parseAliasSpec = do s1 <- T.pack <$> stringLiteral lang
                     reservedOp lang "->"
-                    s2 <- stringLiteral lang
+                    s2 <- T.pack <$> stringLiteral lang
                     return (s1,s2)
 
 parseRulesBody :: Parser Rule
@@ -291,7 +293,7 @@ formatDate :: CondPrim -> Erring CondPrim
 formatDate (CondDate df) = Right $ CondString $ \ctx ->
   let tz = cTimeZone ctx
       local = utcToLocalTime tz `liftM` df ctx
-   in formatTime defaultTimeLocale (iso8601DateFormat Nothing) `liftM` local
+   in T.pack . formatTime defaultTimeLocale (iso8601DateFormat Nothing) <$> local
 formatDate cp = Left $ printf
   "Cannot format an expression of type %s, only $date." (cpType cp)
 
@@ -330,7 +332,7 @@ parseCondPrim = choice
               ] <?> "variable"
         , do regex <- parseRegex <?> "regular expression"
              return $ CondRegex (const (Just regex))
-        , do str <- stringLiteral lang <?> "string"
+        , do str <- T.pack <$> stringLiteral lang <?> "string"
              return $ CondString (const (Just str))
         , try $ do time <- parseTime <?> "time" -- backtrack here, it might have been a number
                    return $ CondTime (const (Just time))
@@ -370,7 +372,7 @@ parseCondPrim = choice
 -}
 
 parseRegex :: Parser RE.Regex
-parseRegex = fmap (flip RE.compile []) $ lexeme lang $ choice
+parseRegex = fmap (flip RE.compile [] . T.pack) $ lexeme lang $ choice
         [ between (char '/') (char '/') (many1 (noneOf "/"))
         , do char 'm'
              c <- anyChar
@@ -407,14 +409,14 @@ parseSetTag = lexeme lang $ do
                                             return $ Activity Nothing tag
                         ]
 
-replaceForbidden :: Maybe String -> Maybe String
-replaceForbidden = liftM $ map go
+replaceForbidden :: Maybe Text -> Maybe Text
+replaceForbidden = liftM $ T.map go
   where
     go c | isLetter c    = c
          | c `elem` "-_" = c
          | otherwise     = '_'
 
-parseTagPart :: Parser (Ctx -> Maybe String)
+parseTagPart :: Parser (Ctx -> Maybe Text)
 parseTagPart = do parts <- many1 (choice
                         [ do char '$'
                              choice
@@ -424,16 +426,16 @@ parseTagPart = do parts <- many1 (choice
                                     return $ getVar varname
                                ] <?> "variable"
                         , do s <- many1 (alphaNum <|> oneOf "-_")
-                             return $ const (Just s)
+                             return $ const (Just (T.pack s))
                         ])
-                  return $ (fmap concat . sequence) <$> sequence parts
+                  return $ (fmap T.concat . sequence) <$> sequence parts
 
 ifThenElse :: Cond -> Rule -> Rule -> Rule
 ifThenElse cond r1 r2 = do res <- cond
                            case res of 
                             Just substs -> r1 . setSubsts substs
                             Nothing -> r2
-  where setSubsts :: [String] -> Ctx -> Ctx
+  where setSubsts :: [Text] -> Ctx -> Ctx
         setSubsts substs ctx = ctx { cSubsts = substs }
         
 
@@ -446,10 +448,10 @@ matchFirst rules = takeFirst <$> sequence rules
         takeFirst (x:xs) = x
 
 
-getBackref :: Integer -> CtxFun String
+getBackref :: Integer -> CtxFun Text
 getBackref n ctx = listToMaybe (drop (fromIntegral n-1) (cSubsts ctx))
 
-getVar :: String -> CtxFun String
+getVar :: String -> CtxFun Text
 getVar v ctx | "current" `isPrefixOf` v = do
                 let var = drop (length "current.") v
                 win <- findActive $ cWindows (tlData (cNow ctx))
@@ -477,14 +479,9 @@ getTimeVar "sampleage" ctx = Just $ cCurrentTime ctx `diffUTCTime` tlTime (cNow
 getDateVar :: String -> CtxFun UTCTime
 getDateVar "date" ctx = Just $ tlTime (cNow ctx)
 
-checkEq :: String -> String -> Cond
-checkEq varname str ctx = do s <- getVar varname ctx
-                             [] `justIf` (s == str)
-
 findActive :: [(Bool, t, t1)] -> Maybe (Bool, t, t1)
 findActive = find (\(a,_,_) -> a)                                 
 
-
 checkActive :: Cond
 checkActive ctx = do (a,_,_) <- cWindowInScope ctx
                      guard a
index 345d4b1..ba583c2 100644 (file)
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Data where
 
 import Data.Time
@@ -9,6 +10,8 @@ import Data.Binary
 import Data.Binary.Put
 import Data.Binary.Get
 import Data.Binary.StringRef
+import qualified Data.Text as T
+import Data.Text (Text)
 import Control.Applicative
 import Control.Monad
 
@@ -24,7 +27,7 @@ instance Functor TimeLogEntry where
         fmap f tl = tl { tlData = f (tlData tl) }
         
 data CaptureData = CaptureData
-        { cWindows :: [ (Bool, String, String) ]
+        { cWindows :: [ (Bool, Text, Text) ]
                 -- ^ Active window, window title, programm name
         , cLastActivity :: Integer -- ^ in milli-seconds
         }
@@ -34,7 +37,7 @@ type ActivityData = [Activity]
 
 data Activity = Activity 
         { activityCategory :: Maybe Category
-        , activityName :: String
+        , activityName :: Text
         }
   deriving (Ord, Eq)
 
@@ -42,17 +45,17 @@ data Activity = Activity
 inactiveActivity = Activity Nothing "inactive"
 
 instance Show Activity where
- show (Activity mbC t) = maybe "" (++":") mbC ++ t
+ show (Activity mbC t) = maybe "" ((++":").T.unpack) mbC ++ (T.unpack t)
 
 instance Read Activity where
  readPrec = readP_to_Prec $ \_ ->
                    (do cat <- munch1 (/= ':')
                        char ':'
                        tag <- many1 ReadP.get
-                       return $ Activity (Just cat) tag)
-                   <++ (Activity Nothing `fmap` many1 ReadP.get)
+                       return $ Activity (Just (T.pack cat)) (T.pack tag))
+                   <++ (Activity Nothing . T.pack <$> many1 ReadP.get)
 
-type Category = String
+type Category = Text
 
 isCategory :: Category -> Activity -> Bool
 isCategory cat (Activity (Just cat') _) = cat == cat'
@@ -113,4 +116,3 @@ getMany n = go [] n
                  -- (>>=)
                  x `seq` go (x:xs) (i-1)
 {-# INLINE getMany #-}
-
index 1dffc85..702905f 100644 (file)
@@ -11,17 +11,23 @@ import Data.Binary
 import Data.Binary.Put
 import Data.Binary.Get
 import Control.Monad
+import Control.Applicative ((<$>))
 import Data.List
 import Data.ByteString.Lazy (ByteString)
+import qualified Data.Text as T
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8, decodeUtf8With, encodeUtf8)
+import Data.Text.Encoding.Error
+import Debug.Trace
 
 class StringReferencingBinary a => ListOfStringable a where
-  listOfStrings :: a -> [String]
+  listOfStrings :: a -> [Text]
 
 -- | An extended version of Binary that passes the list of strings of the
 -- previous sample
 class StringReferencingBinary a where
- ls_put :: [String] -> a -> Put
- ls_get :: [String] -> Get a
+ ls_put :: [Text] -> a -> Put
+ ls_get :: [Text] -> Get a
 
 ------------------------------------------------------------------------
 -- Instances for the first few tuples
@@ -49,7 +55,7 @@ instance StringReferencingBinary a => StringReferencingBinary [a] where
                         ls_getMany strs n
 
 -- | 'ls_get strsMany n' ls_get strs 'n' elements in order, without blowing the stack.
-ls_getMany :: StringReferencingBinary a => [String] -> Int -> Get [a]
+ls_getMany :: StringReferencingBinary a => [Text] -> Int -> Get [a]
 ls_getMany strs n = go [] n
  where
     go xs 0 = return $! reverse xs
@@ -59,7 +65,12 @@ ls_getMany strs n = go [] n
                  x `seq` go (x:xs) (i-1)
 {-# INLINE ls_getMany #-}
 
-instance StringReferencingBinary String where
+
+instance Binary Text where
+        put = put . T.unpack
+        get = T.pack <$> get
+
+instance StringReferencingBinary Text where
         ls_put strs s = case elemIndex s strs of
                 Just i | 0 <= i && i  < 255 - 2 ->
                         put (fromIntegral (succ i) :: Word8)
@@ -81,13 +92,13 @@ instance StringReferencingBinary Int  where { ls_put _ = put; ls_get _ = get }
 instance StringReferencingBinary Integer  where { ls_put _ = put; ls_get _ = get }
 instance StringReferencingBinary Bool  where { ls_put _ = put; ls_get _ = get }
 
-ls_encode :: StringReferencingBinary a => [String] -> a -> ByteString
+ls_encode :: StringReferencingBinary a => [Text] -> a -> ByteString
 ls_encode strs = runPut . ls_put strs
 {-# INLINE ls_encode #-}
 
 -- | Decode a value from a lazy ByteString, reconstructing the original structure.
 --
-ls_decode :: StringReferencingBinary a => [String] -> ByteString -> a
+ls_decode :: StringReferencingBinary a => [Text] -> ByteString -> a
 ls_decode strs = runGet (ls_get strs)
 
 
index bd3d695..dadd614 100644 (file)
@@ -8,12 +8,13 @@ import Data.Ord
 import Text.Printf
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Data.Text (Text)
 
 import Data
 import Categorize
 
 
-data Report = GeneralInfos | TotalTime | Category String | EachCategory
+data Report = GeneralInfos | TotalTime | Category Text | EachCategory
         deriving (Show, Eq)
 
 data Filter = Exclude Activity | Only Activity | AlsoInactive | GeneralCond String
@@ -122,7 +123,7 @@ reportToTable opts (Calculations {..}) r = case r of
                 sortBy (comparing snd) $
                 M.toList sums
         
-        Category cat -> PieChartOfTimePercValues ("Statistics for category " ++ cat) $
+        Category cat -> PieChartOfTimePercValues ("Statistics for category " ++ show cat) $
                 let filteredSums = M.filterWithKey (\a _ -> isCategory cat a) sums
                     uncategorizedTime = totalTimeSel - M.fold (+) 0 filteredSums
                     tooSmallSums = M.filter (\t -> realToFrac t / realToFrac totalTimeSel * 100 < minPercentage) filteredSums
index ec22dde..cfdc742 100644 (file)
@@ -6,6 +6,7 @@ import Data.Time
 import Control.Applicative
 import Control.Monad
 import System.Directory
+import qualified Data.Text as T
 
 import TimeLog (writeTimeLog)
 import qualified Data as D
@@ -56,6 +57,6 @@ upgrade :: TimeLog CaptureData -> D.TimeLog D.CaptureData
 upgrade = map $ \(TimeLogEntry a b c) -> D.TimeLogEntry a b (upgradeCD c)
 
 upgradeCD :: CaptureData -> D.CaptureData
-upgradeCD (CaptureData a b) = D.CaptureData a b
+upgradeCD (CaptureData a b) = D.CaptureData (map (\(b,s1,s2) -> (b, T.pack s1, T.pack s2)) a) b
 
 
index 9814c5c..555c38b 100644 (file)
@@ -7,6 +7,7 @@ import System.Exit
 import System.IO
 import Control.Monad
 import qualified Data.Map as M
+import qualified Data.Text as T
 import Data.List
 import Data.Ord
 import Data.Time
@@ -74,7 +75,7 @@ options =
               (NoArg (Report TotalTime))
               "show total time for each tag"
      , Option "c"       ["category"]
-              (ReqArg (Report . Category) "CATEGORY")
+              (ReqArg (Report . Category . T.pack) "CATEGORY")
               "show statistics about category CATEGORY"
      , Option ""        ["each-category"]
               (NoArg (Report EachCategory))