{-# LANGUAGE OverloadedStrings #-}

module System.Directory.Watchman.FileType
    ( FileType(..)
    , fileTypeChar
    , fileTypeFromChar
    ) where

import Data.ByteString (ByteString)

data FileType
    = TBlockSpecialFile
    | TCharacterSpecialFile
    | TDirectory
    | TRegularFile
    | TNamedPipe
    | TSymbolicLink
    | TSocket
    | TSolarisDoor
    | TUnknown
    deriving (Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq, Eq FileType
Eq FileType
-> (FileType -> FileType -> Ordering)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> FileType)
-> (FileType -> FileType -> FileType)
-> Ord FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmax :: FileType -> FileType -> FileType
>= :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c< :: FileType -> FileType -> Bool
compare :: FileType -> FileType -> Ordering
$ccompare :: FileType -> FileType -> Ordering
$cp1Ord :: Eq FileType
Ord)

fileTypeChar :: FileType -> ByteString
fileTypeChar :: FileType -> ByteString
fileTypeChar FileType
TBlockSpecialFile = ByteString
"b"
fileTypeChar FileType
TCharacterSpecialFile = ByteString
"c"
fileTypeChar FileType
TDirectory = ByteString
"d"
fileTypeChar FileType
TRegularFile = ByteString
"f"
fileTypeChar FileType
TNamedPipe = ByteString
"p"
fileTypeChar FileType
TSymbolicLink = ByteString
"l"
fileTypeChar FileType
TSocket = ByteString
"s"
fileTypeChar FileType
TSolarisDoor = ByteString
"D"

fileTypeFromChar :: ByteString -> FileType
fileTypeFromChar :: ByteString -> FileType
fileTypeFromChar ByteString
"b" = FileType
TBlockSpecialFile
fileTypeFromChar ByteString
"c" = FileType
TCharacterSpecialFile
fileTypeFromChar ByteString
"d" = FileType
TDirectory
fileTypeFromChar ByteString
"f" = FileType
TRegularFile
fileTypeFromChar ByteString
"p" = FileType
TNamedPipe
fileTypeFromChar ByteString
"l" = FileType
TSymbolicLink
fileTypeFromChar ByteString
"s" = FileType
TSocket
fileTypeFromChar ByteString
"D" = FileType
TSolarisDoor
fileTypeFromChar ByteString
_ = FileType
TUnknown