Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
122 lines (107 sloc) 4.07 KB
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
module Main (main) where
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.ByteString (ByteString)
import System.Environment
import qualified Data.Map.Strict as M
import Control.Applicative
import Data.AffineSpace ((.-^))
import Data.Char (digitToInt, isUpper)
import Data.List (foldl')
import Control.Lens
import Data.Thyme
import Data.Attoparsec.ByteString.Char8
data UnixFile = UnixFileGen { _fileInode :: !Int
, _fileHardLinks :: !Int
, _fileAtime :: !UTCTime
, _fileMtime :: !UTCTime
, _fileCtime :: !UTCTime
, _fileUser :: !ByteString
, _fileGroup :: !ByteString
, _fileBlocks :: !Int
, _fileType :: !FileType
, _filePerms :: !FPerms
, _fileSize :: !Int
, _filePath :: !ByteString
, _fileTarget :: !(Maybe ByteString)
} deriving (Show, Eq)
data FileType = TFile
| TDirectory
| TLink
| TPipe
| TSocket
| TBlock
| TChar
| TDoor
deriving (Eq, Show)
char2ft :: Char -> Maybe FileType
char2ft x = case x of
'-' -> Just TFile
'f' -> Just TFile
'd' -> Just TDirectory
'l' -> Just TLink
'p' -> Just TPipe
's' -> Just TSocket
'b' -> Just TBlock
'c' -> Just TChar
'D' -> Just TDoor
_ -> Nothing
newtype FPerms = FPerms Int
deriving (Show, Ord, Eq, Num, Bits)
parseYMD :: Parser Day
parseYMD = do
!y <- decimal <* char '-'
!m <- decimal <* char '-'
!d <- decimal
return $! YearMonthDay y m d ^. from gregorian
parseDTime :: Parser DiffTime
parseDTime = do
!h <- decimal <* char ':'
!mi <- decimal <* char ':'
!s <- scientific
return $! fromSeconds $ fromIntegral (h * 3600 + mi * 60 :: Int) + s
timestamp :: Parser UTCTime
timestamp = do
!day <- parseYMD <* char '+'
!difftime <- parseDTime <* char '+'
let !tm = UTCTime day difftime ^. from utcTime
!tz <- takeWhile1 isUpper <* skipSpace
return $! case tz of
"CEST" -> tm .-^ fromSeconds (7200 :: Int)
"CET" -> tm .-^ fromSeconds (3600 :: Int)
_ -> tm
filetype :: Parser FileType
filetype = anyChar >>= maybe (fail "invalid file type") return . char2ft
myOctal :: Parser Int
myOctal = foldl' (\acc n -> acc * 8 + digitToInt n) 0 <$> some digit
findline :: Parser UnixFile
findline = do
let t :: Parser a -> Parser a
t parser = parser <* skipSpace
!meta <- UnixFileGen <$> t decimal
<*> t decimal
<*> timestamp
<*> timestamp
<*> timestamp
<*> t (takeWhile1 (not . isSpace))
<*> t (takeWhile1 (not . isSpace))
<*> t decimal
<*> t filetype
<*> (FPerms <$> t myOctal)
<*> t decimal
!rst <- BS8.words <$> t (takeWhile1 ( /= '\n' ))
return $! case break (== "->") rst of
(a, []) -> meta (BS8.unwords a) Nothing
(a, ["->"]) -> meta (BS8.unwords a) Nothing
(a, b) -> meta (BS8.unwords a) (Just (BS8.unwords b))
parseFile :: FilePath -> IO [UnixFile]
parseFile fp = either (error . show) id . parseOnly (some findline) <$> BS.readFile fp
main :: IO ()
main = do
parsed <- getArgs >>= mapM parseFile
let resultmap = M.fromList $ map (\f -> (_filePath f, f)) $ concat parsed
print $ M.size resultmap