{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------
-- |
-- Module    : Codec.MIME.Type
-- Copyright : (c) 2006-2009, Galois, Inc. 
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
-- Stability : provisional
-- Portability: portable
--
-- 
-- Representing MIME types and values.
-- 
--------------------------------------------------------------------
module Codec.MIME.Type where

import qualified Data.Text as T
import Data.Monoid ((<>))

data MIMEParam = MIMEParam  { MIMEParam -> Text
paramName     :: T.Text
                            , MIMEParam -> Text
paramValue    :: T.Text }
    deriving (Int -> MIMEParam -> ShowS
[MIMEParam] -> ShowS
MIMEParam -> String
(Int -> MIMEParam -> ShowS)
-> (MIMEParam -> String)
-> ([MIMEParam] -> ShowS)
-> Show MIMEParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIMEParam -> ShowS
showsPrec :: Int -> MIMEParam -> ShowS
$cshow :: MIMEParam -> String
show :: MIMEParam -> String
$cshowList :: [MIMEParam] -> ShowS
showList :: [MIMEParam] -> ShowS
Show, Eq MIMEParam
Eq MIMEParam =>
(MIMEParam -> MIMEParam -> Ordering)
-> (MIMEParam -> MIMEParam -> Bool)
-> (MIMEParam -> MIMEParam -> Bool)
-> (MIMEParam -> MIMEParam -> Bool)
-> (MIMEParam -> MIMEParam -> Bool)
-> (MIMEParam -> MIMEParam -> MIMEParam)
-> (MIMEParam -> MIMEParam -> MIMEParam)
-> Ord MIMEParam
MIMEParam -> MIMEParam -> Bool
MIMEParam -> MIMEParam -> Ordering
MIMEParam -> MIMEParam -> MIMEParam
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
$ccompare :: MIMEParam -> MIMEParam -> Ordering
compare :: MIMEParam -> MIMEParam -> Ordering
$c< :: MIMEParam -> MIMEParam -> Bool
< :: MIMEParam -> MIMEParam -> Bool
$c<= :: MIMEParam -> MIMEParam -> Bool
<= :: MIMEParam -> MIMEParam -> Bool
$c> :: MIMEParam -> MIMEParam -> Bool
> :: MIMEParam -> MIMEParam -> Bool
$c>= :: MIMEParam -> MIMEParam -> Bool
>= :: MIMEParam -> MIMEParam -> Bool
$cmax :: MIMEParam -> MIMEParam -> MIMEParam
max :: MIMEParam -> MIMEParam -> MIMEParam
$cmin :: MIMEParam -> MIMEParam -> MIMEParam
min :: MIMEParam -> MIMEParam -> MIMEParam
Ord, MIMEParam -> MIMEParam -> Bool
(MIMEParam -> MIMEParam -> Bool)
-> (MIMEParam -> MIMEParam -> Bool) -> Eq MIMEParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIMEParam -> MIMEParam -> Bool
== :: MIMEParam -> MIMEParam -> Bool
$c/= :: MIMEParam -> MIMEParam -> Bool
/= :: MIMEParam -> MIMEParam -> Bool
Eq)

data Type = Type
    { Type -> MIMEType
mimeType   :: MIMEType
    , Type -> [MIMEParam]
mimeParams :: [MIMEParam]
    } deriving ( Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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
$ccompare :: Type -> Type -> Ordering
compare :: Type -> Type -> Ordering
$c< :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
>= :: Type -> Type -> Bool
$cmax :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
min :: Type -> Type -> Type
Ord, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq )

-- | The @null@ MIME record type value; currently a @text/plain@.
nullType :: Type
nullType :: Type
nullType = Type
    { mimeType :: MIMEType
mimeType   = Text -> MIMEType
Text Text
"plain"
    , mimeParams :: [MIMEParam]
mimeParams = []
    }

showType :: Type -> T.Text
showType :: Type -> Text
showType Type
t = MIMEType -> Text
showMIMEType (Type -> MIMEType
mimeType Type
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [MIMEParam] -> Text
showMIMEParams (Type -> [MIMEParam]
mimeParams Type
t)

showMIMEParams :: [MIMEParam] -> T.Text
showMIMEParams :: [MIMEParam] -> Text
showMIMEParams [MIMEParam]
ps = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (MIMEParam -> Text) -> [MIMEParam] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MIMEParam -> Text
showP [MIMEParam]
ps
  where 
    showP :: MIMEParam -> Text
showP (MIMEParam Text
a Text
b) = Text
"; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""


data MIMEType
 = Application SubType
 | Audio       SubType
 | Image       SubType
 | Message     SubType
 | Model       SubType
 | Multipart   Multipart
 | Text        TextType
 | Video       SubType
 | Other       {MIMEType -> Text
otherType :: T.Text, MIMEType -> Text
otherSubType :: SubType}
   deriving ( Int -> MIMEType -> ShowS
[MIMEType] -> ShowS
MIMEType -> String
(Int -> MIMEType -> ShowS)
-> (MIMEType -> String) -> ([MIMEType] -> ShowS) -> Show MIMEType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIMEType -> ShowS
showsPrec :: Int -> MIMEType -> ShowS
$cshow :: MIMEType -> String
show :: MIMEType -> String
$cshowList :: [MIMEType] -> ShowS
showList :: [MIMEType] -> ShowS
Show, Eq MIMEType
Eq MIMEType =>
(MIMEType -> MIMEType -> Ordering)
-> (MIMEType -> MIMEType -> Bool)
-> (MIMEType -> MIMEType -> Bool)
-> (MIMEType -> MIMEType -> Bool)
-> (MIMEType -> MIMEType -> Bool)
-> (MIMEType -> MIMEType -> MIMEType)
-> (MIMEType -> MIMEType -> MIMEType)
-> Ord MIMEType
MIMEType -> MIMEType -> Bool
MIMEType -> MIMEType -> Ordering
MIMEType -> MIMEType -> MIMEType
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
$ccompare :: MIMEType -> MIMEType -> Ordering
compare :: MIMEType -> MIMEType -> Ordering
$c< :: MIMEType -> MIMEType -> Bool
< :: MIMEType -> MIMEType -> Bool
$c<= :: MIMEType -> MIMEType -> Bool
<= :: MIMEType -> MIMEType -> Bool
$c> :: MIMEType -> MIMEType -> Bool
> :: MIMEType -> MIMEType -> Bool
$c>= :: MIMEType -> MIMEType -> Bool
>= :: MIMEType -> MIMEType -> Bool
$cmax :: MIMEType -> MIMEType -> MIMEType
max :: MIMEType -> MIMEType -> MIMEType
$cmin :: MIMEType -> MIMEType -> MIMEType
min :: MIMEType -> MIMEType -> MIMEType
Ord, MIMEType -> MIMEType -> Bool
(MIMEType -> MIMEType -> Bool)
-> (MIMEType -> MIMEType -> Bool) -> Eq MIMEType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIMEType -> MIMEType -> Bool
== :: MIMEType -> MIMEType -> Bool
$c/= :: MIMEType -> MIMEType -> Bool
/= :: MIMEType -> MIMEType -> Bool
Eq )

showMIMEType :: MIMEType -> T.Text
showMIMEType :: MIMEType -> Text
showMIMEType MIMEType
t = 
 case MIMEType
t of
   Application Text
s -> Text
"application/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s
   Audio Text
s       -> Text
"audio/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s
   Image Text
s       -> Text
"image/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s
   Message Text
s     -> Text
"message/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s
   Model Text
s       -> Text
"model/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s
   Multipart Multipart
s   -> Text
"multipart/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Multipart -> Text
showMultipart Multipart
s
   Text Text
s        -> Text
"text/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s
   Video Text
s       -> Text
"video/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s
   Other Text
a Text
b     -> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

-- | a (type, subtype) MIME pair.
data MIMEPair
 = MIMEPair T.Text SubType
   deriving ( MIMEPair -> MIMEPair -> Bool
(MIMEPair -> MIMEPair -> Bool)
-> (MIMEPair -> MIMEPair -> Bool) -> Eq MIMEPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIMEPair -> MIMEPair -> Bool
== :: MIMEPair -> MIMEPair -> Bool
$c/= :: MIMEPair -> MIMEPair -> Bool
/= :: MIMEPair -> MIMEPair -> Bool
Eq )

showMIMEPair :: MIMEPair -> T.Text
showMIMEPair :: MIMEPair -> Text
showMIMEPair (MIMEPair Text
a Text
b) = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

-- | default subtype representation.
type SubType = T.Text

-- | subtype for text content; currently just a string.
type TextType = SubType

subTypeString :: Type -> T.Text
subTypeString :: Type -> Text
subTypeString Type
t = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (MIMEType -> Text
showMIMEType (Type -> MIMEType
mimeType Type
t))

majTypeString :: Type -> T.Text
majTypeString :: Type -> Text
majTypeString Type
t = (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (MIMEType -> Text
showMIMEType (Type -> MIMEType
mimeType Type
t))

data Multipart
 = Alternative
 | Byteranges
 | Digest
 | Encrypted
 | FormData
 | Mixed
 | Parallel
 | Related
 | Signed
 | Extension  T.Text  -- ^ e.g., 'x-foo' (i.e., includes the 'x-' bit)
 | OtherMulti T.Text  -- unrecognized\/uninterpreted.
                      -- (e.g., appledouble, voice-message, etc.)
   deriving ( Int -> Multipart -> ShowS
[Multipart] -> ShowS
Multipart -> String
(Int -> Multipart -> ShowS)
-> (Multipart -> String)
-> ([Multipart] -> ShowS)
-> Show Multipart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Multipart -> ShowS
showsPrec :: Int -> Multipart -> ShowS
$cshow :: Multipart -> String
show :: Multipart -> String
$cshowList :: [Multipart] -> ShowS
showList :: [Multipart] -> ShowS
Show, Eq Multipart
Eq Multipart =>
(Multipart -> Multipart -> Ordering)
-> (Multipart -> Multipart -> Bool)
-> (Multipart -> Multipart -> Bool)
-> (Multipart -> Multipart -> Bool)
-> (Multipart -> Multipart -> Bool)
-> (Multipart -> Multipart -> Multipart)
-> (Multipart -> Multipart -> Multipart)
-> Ord Multipart
Multipart -> Multipart -> Bool
Multipart -> Multipart -> Ordering
Multipart -> Multipart -> Multipart
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
$ccompare :: Multipart -> Multipart -> Ordering
compare :: Multipart -> Multipart -> Ordering
$c< :: Multipart -> Multipart -> Bool
< :: Multipart -> Multipart -> Bool
$c<= :: Multipart -> Multipart -> Bool
<= :: Multipart -> Multipart -> Bool
$c> :: Multipart -> Multipart -> Bool
> :: Multipart -> Multipart -> Bool
$c>= :: Multipart -> Multipart -> Bool
>= :: Multipart -> Multipart -> Bool
$cmax :: Multipart -> Multipart -> Multipart
max :: Multipart -> Multipart -> Multipart
$cmin :: Multipart -> Multipart -> Multipart
min :: Multipart -> Multipart -> Multipart
Ord, Multipart -> Multipart -> Bool
(Multipart -> Multipart -> Bool)
-> (Multipart -> Multipart -> Bool) -> Eq Multipart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Multipart -> Multipart -> Bool
== :: Multipart -> Multipart -> Bool
$c/= :: Multipart -> Multipart -> Bool
/= :: Multipart -> Multipart -> Bool
Eq )

isXmlBased :: Type -> Bool
isXmlBased :: Type -> Bool
isXmlBased Type
t = 
  case Type -> MIMEType
mimeType Type
t of
     Multipart{} -> Bool
False
     MIMEType
_ -> Text
"+xml" Text -> Text -> Bool
`T.isSuffixOf` Type -> Text
subTypeString Type
t

isXmlType :: Type -> Bool
isXmlType :: Type -> Bool
isXmlType Type
t = Type -> Bool
isXmlBased Type
t Bool -> Bool -> Bool
||
  case Type -> MIMEType
mimeType Type
t of
    Application Text
s -> Text
s Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
xml_media_types
    Text Text
s        -> Text
s Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
xml_media_types
    MIMEType
_             -> Bool
False
 where
    -- Note: xml-dtd isn't considered an XML type here.
  xml_media_types :: [T.Text]
  xml_media_types :: [Text]
xml_media_types = 
    [ Text
"xml"
    , Text
"xml-external-parsed-entity"
    ]
  

showMultipart :: Multipart -> T.Text
showMultipart :: Multipart -> Text
showMultipart Multipart
m = 
 case Multipart
m of
   Multipart
Alternative -> Text
"alternative"
   Multipart
Byteranges  -> Text
"byteranges"
   Multipart
Digest      -> Text
"digest"
   Multipart
Encrypted   -> Text
"encrypted"
   Multipart
FormData    -> Text
"form-data"
   Multipart
Mixed       -> Text
"mixed"
   Multipart
Parallel    -> Text
"parallel"
   Multipart
Related     -> Text
"related"
   Multipart
Signed      -> Text
"signed"
   Extension Text
e -> Text
e
   OtherMulti Text
e -> Text
e
   
type Content = T.Text

data MIMEValue = MIMEValue
      { MIMEValue -> Type
mime_val_type     :: Type
      , MIMEValue -> Maybe Disposition
mime_val_disp     :: Maybe Disposition
      , MIMEValue -> MIMEContent
mime_val_content  :: MIMEContent
      , MIMEValue -> [MIMEParam]
mime_val_headers  :: [MIMEParam]
      , MIMEValue -> Bool
mime_val_inc_type :: Bool
      } deriving ( Int -> MIMEValue -> ShowS
[MIMEValue] -> ShowS
MIMEValue -> String
(Int -> MIMEValue -> ShowS)
-> (MIMEValue -> String)
-> ([MIMEValue] -> ShowS)
-> Show MIMEValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIMEValue -> ShowS
showsPrec :: Int -> MIMEValue -> ShowS
$cshow :: MIMEValue -> String
show :: MIMEValue -> String
$cshowList :: [MIMEValue] -> ShowS
showList :: [MIMEValue] -> ShowS
Show, MIMEValue -> MIMEValue -> Bool
(MIMEValue -> MIMEValue -> Bool)
-> (MIMEValue -> MIMEValue -> Bool) -> Eq MIMEValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIMEValue -> MIMEValue -> Bool
== :: MIMEValue -> MIMEValue -> Bool
$c/= :: MIMEValue -> MIMEValue -> Bool
/= :: MIMEValue -> MIMEValue -> Bool
Eq )

nullMIMEValue :: MIMEValue
nullMIMEValue :: MIMEValue
nullMIMEValue = MIMEValue
      { mime_val_type :: Type
mime_val_type     = Type
nullType
      , mime_val_disp :: Maybe Disposition
mime_val_disp     = Maybe Disposition
forall a. Maybe a
Nothing
      , mime_val_content :: MIMEContent
mime_val_content  = [MIMEValue] -> MIMEContent
Multi []
      , mime_val_headers :: [MIMEParam]
mime_val_headers  = []
      , mime_val_inc_type :: Bool
mime_val_inc_type = Bool
True
      } 

data MIMEContent 
  = Single Content
  | Multi [MIMEValue]
    deriving (MIMEContent -> MIMEContent -> Bool
(MIMEContent -> MIMEContent -> Bool)
-> (MIMEContent -> MIMEContent -> Bool) -> Eq MIMEContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIMEContent -> MIMEContent -> Bool
== :: MIMEContent -> MIMEContent -> Bool
$c/= :: MIMEContent -> MIMEContent -> Bool
/= :: MIMEContent -> MIMEContent -> Bool
Eq,Int -> MIMEContent -> ShowS
[MIMEContent] -> ShowS
MIMEContent -> String
(Int -> MIMEContent -> ShowS)
-> (MIMEContent -> String)
-> ([MIMEContent] -> ShowS)
-> Show MIMEContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIMEContent -> ShowS
showsPrec :: Int -> MIMEContent -> ShowS
$cshow :: MIMEContent -> String
show :: MIMEContent -> String
$cshowList :: [MIMEContent] -> ShowS
showList :: [MIMEContent] -> ShowS
Show)
   
data Disposition
 = Disposition
     { Disposition -> DispType
dispType   :: DispType
     , Disposition -> [DispParam]
dispParams :: [DispParam]
     } deriving ( Int -> Disposition -> ShowS
[Disposition] -> ShowS
Disposition -> String
(Int -> Disposition -> ShowS)
-> (Disposition -> String)
-> ([Disposition] -> ShowS)
-> Show Disposition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Disposition -> ShowS
showsPrec :: Int -> Disposition -> ShowS
$cshow :: Disposition -> String
show :: Disposition -> String
$cshowList :: [Disposition] -> ShowS
showList :: [Disposition] -> ShowS
Show, Disposition -> Disposition -> Bool
(Disposition -> Disposition -> Bool)
-> (Disposition -> Disposition -> Bool) -> Eq Disposition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Disposition -> Disposition -> Bool
== :: Disposition -> Disposition -> Bool
$c/= :: Disposition -> Disposition -> Bool
/= :: Disposition -> Disposition -> Bool
Eq )

data DispType
 = DispInline
 | DispAttachment
 | DispFormData
 | DispOther T.Text
   deriving ( Int -> DispType -> ShowS
[DispType] -> ShowS
DispType -> String
(Int -> DispType -> ShowS)
-> (DispType -> String) -> ([DispType] -> ShowS) -> Show DispType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DispType -> ShowS
showsPrec :: Int -> DispType -> ShowS
$cshow :: DispType -> String
show :: DispType -> String
$cshowList :: [DispType] -> ShowS
showList :: [DispType] -> ShowS
Show, DispType -> DispType -> Bool
(DispType -> DispType -> Bool)
-> (DispType -> DispType -> Bool) -> Eq DispType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DispType -> DispType -> Bool
== :: DispType -> DispType -> Bool
$c/= :: DispType -> DispType -> Bool
/= :: DispType -> DispType -> Bool
Eq)

data DispParam
 = Name T.Text
 | Filename T.Text
 | CreationDate T.Text
 | ModDate T.Text
 | ReadDate T.Text
 | Size T.Text
 | OtherParam T.Text T.Text
   deriving ( Int -> DispParam -> ShowS
[DispParam] -> ShowS
DispParam -> String
(Int -> DispParam -> ShowS)
-> (DispParam -> String)
-> ([DispParam] -> ShowS)
-> Show DispParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DispParam -> ShowS
showsPrec :: Int -> DispParam -> ShowS
$cshow :: DispParam -> String
show :: DispParam -> String
$cshowList :: [DispParam] -> ShowS
showList :: [DispParam] -> ShowS
Show, DispParam -> DispParam -> Bool
(DispParam -> DispParam -> Bool)
-> (DispParam -> DispParam -> Bool) -> Eq DispParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DispParam -> DispParam -> Bool
== :: DispParam -> DispParam -> Bool
$c/= :: DispParam -> DispParam -> Bool
/= :: DispParam -> DispParam -> Bool
Eq)