Data.hsc

-- AUTO-GENERATED FILE, DO NOT EDIT.  GENERATED BY utils/genconsts.hs
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PatternSynonyms #-}
{- |
   Module     : Magic.Data
   Copyright  : Copyright (C) 2005 John Goerzen
   License    : BSD-3-Clause

   Maintainer : Philippe <philippedev101\@gmail.com>
   Stability  : provisional
   Portability: portable

The t'MagicFlags' bit-mask, mapping the C @libmagic@ @MAGIC_*@ constants to
Haskell. Flags are combined with @('<>')@, tested with 'hasFlag', and narrowed
with 'removeFlags'; the empty set ('mempty') is 'MagicNone'.
-}

module Magic.Data
  ( MagicFlags(..)
  , hasFlag
  , removeFlags
  , pattern MagicNone
  , pattern MagicDebug
  , pattern MagicSymlink
  , pattern MagicCompress
  , pattern MagicDevices
  , pattern MagicMimeType
  , pattern MagicMimeEncoding
  , pattern MagicMime
  , pattern MagicContinue
  , pattern MagicCheck
  , pattern MagicPreserveAtime
  , pattern MagicRaw
  , pattern MagicError
  , pattern MagicApple
  , pattern MagicExtension
  , pattern MagicCompressTransp
  , pattern MagicNoCompressFork
  , pattern MagicNodesc
  , pattern MagicNoCheckCompress
  , pattern MagicNoCheckTar
  , pattern MagicNoCheckSoft
  , pattern MagicNoCheckApptype
  , pattern MagicNoCheckElf
  , pattern MagicNoCheckText
  , pattern MagicNoCheckCdf
  , pattern MagicNoCheckCsv
  , pattern MagicNoCheckTokens
  , pattern MagicNoCheckEncoding
  , pattern MagicNoCheckJson
  , pattern MagicNoCheckSimh
  , pattern MagicNoCheckBuiltin
  ) where

#include "magic.h"

import Control.DeepSeq (NFData(rnf))
import Data.Bits ((.&.), (.|.), complement, popCount)
import Data.List (intercalate)
import Foreign.C.Types (CInt)
import GHC.Generics (Generic)

-- | A set of @libmagic@ flags, represented as the underlying C bit-mask.
-- Combine flags with @('<>')@, start from 'mempty' (no flags), test
-- membership with 'hasFlag', and narrow with 'removeFlags'. The
-- v'MagicFlags' constructor is an escape hatch for passing a raw mask;
-- prefer the pattern synonyms below.
--
-- @since 2.0.0
newtype MagicFlags = MagicFlags CInt
  deriving (Eq, Ord, Generic)

instance NFData MagicFlags where rnf (MagicFlags x) = x `seq` ()

-- | Flags combine by bitwise-or.
instance Semigroup MagicFlags where
  MagicFlags a <> MagicFlags b = MagicFlags (a .|. b)

-- | 'mempty' is the empty flag set ('MagicNone').
instance Monoid MagicFlags where
  mempty = MagicFlags 0

-- | Prints the set flags by name (e.g. @MagicMimeType <> MagicError@), or
-- @MagicNone@ when empty. Any bits not corresponding to a known flag are
-- shown as a raw @MagicFlags n@ term.
instance Show MagicFlags where
  showsPrec p fs =
    case names of
      []  -> showString "MagicNone"
      [n] -> showString n
      _   -> showParen (p > 6) (showString (intercalate " <> " names))
    where
      MagicFlags raw = fs
      set      = [ (n, v) | (n, MagicFlags v) <- allNamedFlags, popCount v == 1, raw .&. v == v ]
      covered  = foldr (\(_, v) acc -> v .|. acc) (0 :: CInt) set
      leftover = raw .&. complement covered
      names    = map fst set ++ [ "MagicFlags " ++ show leftover | leftover /= (0 :: CInt) ]

-- | @'hasFlag' fs flag@ is 'True' when every bit of @flag@ is set in @fs@.
-- Works for composite flags too (e.g. @fs \`hasFlag\` 'MagicMime'@). Note
-- that @fs \`hasFlag\` 'MagicNone'@ is always 'True' (the empty set is a
-- subset of everything).
--
-- @since 2.0.0
hasFlag :: MagicFlags -> MagicFlags -> Bool
hasFlag (MagicFlags x) (MagicFlags m) = x .&. m == m

-- | @'removeFlags' fs drop@ clears every bit of @drop@ from @fs@ (set
-- difference), e.g. @flags \`removeFlags\` 'MagicError'@.
--
-- @since 2.0.0
removeFlags :: MagicFlags -> MagicFlags -> MagicFlags
removeFlags (MagicFlags a) (MagicFlags b) = MagicFlags (a .&. complement b)

-- | No special handling; return a textual description (the default). This is 'mempty'.
pattern MagicNone :: MagicFlags
pattern MagicNone = MagicFlags (#{const MAGIC_NONE})

-- | Print debugging messages to stderr.
pattern MagicDebug :: MagicFlags
pattern MagicDebug = MagicFlags (#{const MAGIC_DEBUG})

-- | Follow symbolic links.
pattern MagicSymlink :: MagicFlags
pattern MagicSymlink = MagicFlags (#{const MAGIC_SYMLINK})

-- | Look inside compressed files.
pattern MagicCompress :: MagicFlags
pattern MagicCompress = MagicFlags (#{const MAGIC_COMPRESS})

-- | Look at the contents of block or character special devices.
pattern MagicDevices :: MagicFlags
pattern MagicDevices = MagicFlags (#{const MAGIC_DEVICES})

-- | Return a MIME type string instead of a textual description.
pattern MagicMimeType :: MagicFlags
pattern MagicMimeType = MagicFlags (#{const MAGIC_MIME_TYPE})

-- | Return the MIME encoding (character set) instead of a textual description.
pattern MagicMimeEncoding :: MagicFlags
pattern MagicMimeEncoding = MagicFlags (#{const MAGIC_MIME_ENCODING})

-- | Return both the MIME type and the encoding (@'MagicMimeType' '<>' 'MagicMimeEncoding'@).
pattern MagicMime :: MagicFlags
pattern MagicMime = MagicFlags (#{const MAGIC_MIME})

-- | Return all matches, not just the first.
pattern MagicContinue :: MagicFlags
pattern MagicContinue = MagicFlags (#{const MAGIC_CONTINUE})

-- | Check the magic database for consistency and report problems.
pattern MagicCheck :: MagicFlags
pattern MagicCheck = MagicFlags (#{const MAGIC_CHECK})

-- | Preserve the access time of examined files.
pattern MagicPreserveAtime :: MagicFlags
pattern MagicPreserveAtime = MagicFlags (#{const MAGIC_PRESERVE_ATIME})

-- | Do not translate unprintable characters to octal escapes.
pattern MagicRaw :: MagicFlags
pattern MagicRaw = MagicFlags (#{const MAGIC_RAW})

-- | Treat errors while examining a file as real errors instead of embedding them in the result.
pattern MagicError :: MagicFlags
pattern MagicError = MagicFlags (#{const MAGIC_ERROR})

-- | Return the Apple creator and type.
pattern MagicApple :: MagicFlags
pattern MagicApple = MagicFlags (#{const MAGIC_APPLE})

-- | Return a slash-separated list of valid file extensions for the detected type.
pattern MagicExtension :: MagicFlags
pattern MagicExtension = MagicFlags (#{const MAGIC_EXTENSION})

-- | Report on the compressed contents only, without mentioning the compression itself (transparent decompression).
pattern MagicCompressTransp :: MagicFlags
pattern MagicCompressTransp = MagicFlags (#{const MAGIC_COMPRESS_TRANSP})

-- | Do not allow decompression that requires forking a helper process.
pattern MagicNoCompressFork :: MagicFlags
pattern MagicNoCompressFork = MagicFlags (#{const MAGIC_NO_COMPRESS_FORK})

-- | Composite of 'MagicExtension', 'MagicMime' and 'MagicApple': return identifiers rather than a textual description.
pattern MagicNodesc :: MagicFlags
pattern MagicNodesc = MagicFlags (#{const MAGIC_NODESC})

-- | Do not look inside compressed files.
pattern MagicNoCheckCompress :: MagicFlags
pattern MagicNoCheckCompress = MagicFlags (#{const MAGIC_NO_CHECK_COMPRESS})

-- | Do not examine tar archives.
pattern MagicNoCheckTar :: MagicFlags
pattern MagicNoCheckTar = MagicFlags (#{const MAGIC_NO_CHECK_TAR})

-- | Do not consult the magic database entries (soft magic).
pattern MagicNoCheckSoft :: MagicFlags
pattern MagicNoCheckSoft = MagicFlags (#{const MAGIC_NO_CHECK_SOFT})

-- | Do not check for an application type (e.g. EMX).
pattern MagicNoCheckApptype :: MagicFlags
pattern MagicNoCheckApptype = MagicFlags (#{const MAGIC_NO_CHECK_APPTYPE})

-- | Do not examine ELF details.
pattern MagicNoCheckElf :: MagicFlags
pattern MagicNoCheckElf = MagicFlags (#{const MAGIC_NO_CHECK_ELF})

-- | Do not examine text files.
pattern MagicNoCheckText :: MagicFlags
pattern MagicNoCheckText = MagicFlags (#{const MAGIC_NO_CHECK_TEXT})

-- | Do not examine CDF (Microsoft Compound Document) files.
pattern MagicNoCheckCdf :: MagicFlags
pattern MagicNoCheckCdf = MagicFlags (#{const MAGIC_NO_CHECK_CDF})

-- | Do not examine CSV files.
pattern MagicNoCheckCsv :: MagicFlags
pattern MagicNoCheckCsv = MagicFlags (#{const MAGIC_NO_CHECK_CSV})

-- | Do not look for known text tokens.
pattern MagicNoCheckTokens :: MagicFlags
pattern MagicNoCheckTokens = MagicFlags (#{const MAGIC_NO_CHECK_TOKENS})

-- | Do not check text encodings.
pattern MagicNoCheckEncoding :: MagicFlags
pattern MagicNoCheckEncoding = MagicFlags (#{const MAGIC_NO_CHECK_ENCODING})

-- | Do not examine JSON files.
pattern MagicNoCheckJson :: MagicFlags
pattern MagicNoCheckJson = MagicFlags (#{const MAGIC_NO_CHECK_JSON})

-- | Do not examine SIMH tape files.
pattern MagicNoCheckSimh :: MagicFlags
pattern MagicNoCheckSimh = MagicFlags (#{const MAGIC_NO_CHECK_SIMH})

-- | Disable all built-in tests; consult only the magic database.
pattern MagicNoCheckBuiltin :: MagicFlags
pattern MagicNoCheckBuiltin = MagicFlags (#{const MAGIC_NO_CHECK_BUILTIN})

-- Every named flag, used by the 'Show' instance to print flags by name.
allNamedFlags :: [(String, MagicFlags)]
allNamedFlags =
  [ ("MagicNone", MagicNone)
  , ("MagicDebug", MagicDebug)
  , ("MagicSymlink", MagicSymlink)
  , ("MagicCompress", MagicCompress)
  , ("MagicDevices", MagicDevices)
  , ("MagicMimeType", MagicMimeType)
  , ("MagicMimeEncoding", MagicMimeEncoding)
  , ("MagicMime", MagicMime)
  , ("MagicContinue", MagicContinue)
  , ("MagicCheck", MagicCheck)
  , ("MagicPreserveAtime", MagicPreserveAtime)
  , ("MagicRaw", MagicRaw)
  , ("MagicError", MagicError)
  , ("MagicApple", MagicApple)
  , ("MagicExtension", MagicExtension)
  , ("MagicCompressTransp", MagicCompressTransp)
  , ("MagicNoCompressFork", MagicNoCompressFork)
  , ("MagicNodesc", MagicNodesc)
  , ("MagicNoCheckCompress", MagicNoCheckCompress)
  , ("MagicNoCheckTar", MagicNoCheckTar)
  , ("MagicNoCheckSoft", MagicNoCheckSoft)
  , ("MagicNoCheckApptype", MagicNoCheckApptype)
  , ("MagicNoCheckElf", MagicNoCheckElf)
  , ("MagicNoCheckText", MagicNoCheckText)
  , ("MagicNoCheckCdf", MagicNoCheckCdf)
  , ("MagicNoCheckCsv", MagicNoCheckCsv)
  , ("MagicNoCheckTokens", MagicNoCheckTokens)
  , ("MagicNoCheckEncoding", MagicNoCheckEncoding)
  , ("MagicNoCheckJson", MagicNoCheckJson)
  , ("MagicNoCheckSimh", MagicNoCheckSimh)
  , ("MagicNoCheckBuiltin", MagicNoCheckBuiltin)
  ]