module Text.XML.Basic.Attribute where

import qualified Text.XML.Basic.Name as Name
import qualified Text.XML.Basic.Format as Fmt

import Text.XML.Basic.Utility (updateAppend, )

import qualified Data.Accessor.Basic as Accessor

import Data.Foldable (Foldable(foldMap), )
import Data.Traversable (Traversable, sequenceA, traverse, )
import Control.Applicative (Applicative, pure, liftA, )

import qualified Data.List as List

import Prelude hiding (any, )


{- | An HTML attribute @id=\"name\"@ generates @(\"id\",\"name\")@ -}
data T name string =
   Cons {
      forall name string. T name string -> Name name
name_  :: Name name,
      forall name string. T name string -> string
value_ :: string
   } deriving (T name string -> T name string -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall name string.
(Eq name, Eq string) =>
T name string -> T name string -> Bool
/= :: T name string -> T name string -> Bool
$c/= :: forall name string.
(Eq name, Eq string) =>
T name string -> T name string -> Bool
== :: T name string -> T name string -> Bool
$c== :: forall name string.
(Eq name, Eq string) =>
T name string -> T name string -> Bool
Eq, T name string -> T name string -> Bool
T name string -> T name string -> Ordering
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
forall {name} {string}.
(Ord name, Ord string) =>
Eq (T name string)
forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Ordering
forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> T name string
min :: T name string -> T name string -> T name string
$cmin :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> T name string
max :: T name string -> T name string -> T name string
$cmax :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> T name string
>= :: T name string -> T name string -> Bool
$c>= :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
> :: T name string -> T name string -> Bool
$c> :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
<= :: T name string -> T name string -> Bool
$c<= :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
< :: T name string -> T name string -> Bool
$c< :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Bool
compare :: T name string -> T name string -> Ordering
$ccompare :: forall name string.
(Ord name, Ord string) =>
T name string -> T name string -> Ordering
Ord)

cons :: (Name.Attribute name) => Name name -> string -> T name string
cons :: forall name string.
Attribute name =>
Name name -> string -> T name string
cons = forall name string. Name name -> string -> T name string
Cons

new :: (Name.Attribute name) => String -> string -> T name string
new :: forall name string.
Attribute name =>
String -> string -> T name string
new String
n string
v = forall name string. Name name -> string -> T name string
Cons (forall name. C name => String -> name
Name.fromString String
n) string
v

lift ::
   (Name name -> string -> (Name name, string)) ->
   T name string -> T name string
lift :: forall name string.
(Name name -> string -> (Name name, string))
-> T name string -> T name string
lift Name name -> string -> (Name name, string)
f (Cons Name name
n string
v) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall name string. Name name -> string -> T name string
Cons forall a b. (a -> b) -> a -> b
$ Name name -> string -> (Name name, string)
f Name name
n string
v

toPair :: (Name.Attribute name) => T name string -> (String, string)
toPair :: forall name string.
Attribute name =>
T name string -> (String, string)
toPair (Cons Name name
n string
v) = (forall name. C name => name -> String
Name.toString Name name
n, string
v)

fromPair :: (Name.Attribute name) => (String, string) -> T name string
fromPair :: forall name string.
Attribute name =>
(String, string) -> T name string
fromPair (String
n,string
v) = forall name string. Name name -> string -> T name string
Cons (forall name. C name => String -> name
Name.fromString String
n) string
v

name :: Accessor.T (T name string) (Name name)
name :: forall name string. T (T name string) (Name name)
name = forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\Name name
n T name string
p -> T name string
p{name_ :: Name name
name_ = Name name
n}) forall name string. T name string -> Name name
name_

value :: Accessor.T (T name string) string
value :: forall name string. T (T name string) string
value = forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\string
n T name string
p -> T name string
p{value_ :: string
value_ = string
n}) forall name string. T name string -> string
value_


instance (Name.Attribute name, Show string) => Show (T name string) where
   showsPrec :: Int -> T name string -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string.
Attribute name =>
T name string -> (String, string)
toPair

instance (Name.Attribute name, Fmt.C string) => Fmt.C (T name string) where
   run :: T name string -> ShowS
run T name string
attr =
      forall name. C name => name -> ShowS
Fmt.name (forall name string. T name string -> Name name
name_ T name string
attr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Fmt.eq forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
Fmt.stringQuoted (forall object. C object => object -> ShowS
Fmt.run (forall name string. T name string -> string
value_ T name string
attr) String
"")

{- |
Each attribute is preceded by a space,
that is there is a space between adjacent attributes
and one leading space.
-}
formatListBlankHead ::
   (Name.Attribute name, Fmt.C string) =>
   [T name string] -> ShowS
formatListBlankHead :: forall name string.
(Attribute name, C string) =>
[T name string] -> ShowS
formatListBlankHead =
   forall a. (a -> ShowS) -> [a] -> ShowS
Fmt.many (\T name string
attr -> ShowS
Fmt.blank forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall object. C object => object -> ShowS
Fmt.run T name string
attr)

instance Functor (T name) where
   fmap :: forall a b. (a -> b) -> T name a -> T name b
fmap a -> b
f (Cons Name name
n a
v) = forall name string. Name name -> string -> T name string
Cons Name name
n (a -> b
f a
v)

instance Foldable (T name) where
   foldMap :: forall m a. Monoid m => (a -> m) -> T name a -> m
foldMap a -> m
f (Cons Name name
_n a
v) = a -> m
f a
v

instance Traversable (T name) where
   sequenceA :: forall (f :: * -> *) a.
Applicative f =>
T name (f a) -> f (T name a)
sequenceA (Cons Name name
n f a
v) = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (forall name string. Name name -> string -> T name string
Cons Name name
n) f a
v



mapName :: (Name name0 -> Name name1) -> T name0 string -> T name1 string
mapName :: forall name0 name1 string.
(Name name0 -> Name name1) -> T name0 string -> T name1 string
mapName Name name0 -> Name name1
f (Cons Name name0
n string
v) = forall name string. Name name -> string -> T name string
Cons (Name name0 -> Name name1
f Name name0
n) string
v



newtype Name ident = Name {forall ident. Name ident -> ident
unname :: ident}
   deriving (Name ident -> Name ident -> Bool
forall ident. Eq ident => Name ident -> Name ident -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name ident -> Name ident -> Bool
$c/= :: forall ident. Eq ident => Name ident -> Name ident -> Bool
== :: Name ident -> Name ident -> Bool
$c== :: forall ident. Eq ident => Name ident -> Name ident -> Bool
Eq, Name ident -> Name ident -> Bool
Name ident -> Name ident -> Ordering
Name ident -> Name ident -> Name ident
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
forall {ident}. Ord ident => Eq (Name ident)
forall ident. Ord ident => Name ident -> Name ident -> Bool
forall ident. Ord ident => Name ident -> Name ident -> Ordering
forall ident. Ord ident => Name ident -> Name ident -> Name ident
min :: Name ident -> Name ident -> Name ident
$cmin :: forall ident. Ord ident => Name ident -> Name ident -> Name ident
max :: Name ident -> Name ident -> Name ident
$cmax :: forall ident. Ord ident => Name ident -> Name ident -> Name ident
>= :: Name ident -> Name ident -> Bool
$c>= :: forall ident. Ord ident => Name ident -> Name ident -> Bool
> :: Name ident -> Name ident -> Bool
$c> :: forall ident. Ord ident => Name ident -> Name ident -> Bool
<= :: Name ident -> Name ident -> Bool
$c<= :: forall ident. Ord ident => Name ident -> Name ident -> Bool
< :: Name ident -> Name ident -> Bool
$c< :: forall ident. Ord ident => Name ident -> Name ident -> Bool
compare :: Name ident -> Name ident -> Ordering
$ccompare :: forall ident. Ord ident => Name ident -> Name ident -> Ordering
Ord)

instance Show ident => Show (Name ident) where
   showsPrec :: Int -> Name ident -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ident. Name ident -> ident
unname

instance Name.Attribute ident => Name.C (Name ident) where
   fromString :: String -> Name ident
fromString = forall ident. ident -> Name ident
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ident. Attribute ident => String -> ident
Name.attributeFromString
   toString :: Name ident -> String
toString = forall ident. Attribute ident => ident -> String
Name.attributeToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ident. Name ident -> ident
unname


versionName :: (Name.Attribute name) => Name name
versionName :: forall name. Attribute name => Name name
versionName = forall name. C name => String -> name
Name.fromString String
versionString

encodingName :: (Name.Attribute name) => Name name
encodingName :: forall name. Attribute name => Name name
encodingName = forall name. C name => String -> name
Name.fromString String
encodingString


versionString :: String
versionString :: String
versionString = String
"version"

encodingString :: String
encodingString :: String
encodingString = String
"encoding"


-- * attribute lists

mapValues ::
   (str0 -> str1) ->
   ([T name str0] -> [T name str1])
mapValues :: forall str0 str1 name.
(str0 -> str1) -> [T name str0] -> [T name str1]
mapValues str0 -> str1
f =
   forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap str0 -> str1
f)

mapValuesA :: Applicative f =>
   (str0 -> f str1) ->
   ([T name str0] -> f [T name str1])
mapValuesA :: forall (f :: * -> *) str0 str1 name.
Applicative f =>
(str0 -> f str1) -> [T name str0] -> f [T name str1]
mapValuesA str0 -> f str1
f =
   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse str0 -> f str1
f)


{- |
Process specific attributes of an attribute list.
The function name is inspired by Data.Map.
-}
adjustOn ::
   (Name name -> Bool) ->
   (string -> string) ->
   ([T name string] -> [T name string])
adjustOn :: forall name string.
(Name name -> Bool)
-> (string -> string) -> [T name string] -> [T name string]
adjustOn Name name -> Bool
p string -> string
f =
   forall a b. (a -> b) -> [a] -> [b]
map (\T name string
attr ->
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (if Name name -> Bool
p (forall name string. T name string -> Name name
name_ T name string
attr) then string -> string
f else forall a. a -> a
id) T name string
attr)

adjustOnA :: Applicative f =>
   (Name name -> Bool) ->
   (string -> f string) ->
   ([T name string] -> f [T name string])
adjustOnA :: forall (f :: * -> *) name string.
Applicative f =>
(Name name -> Bool)
-> (string -> f string) -> [T name string] -> f [T name string]
adjustOnA Name name -> Bool
p string -> f string
f =
   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\T name string
attr ->
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (if Name name -> Bool
p (forall name string. T name string -> Name name
name_ T name string
attr) then string -> f string
f else forall (f :: * -> *) a. Applicative f => a -> f a
pure) T name string
attr)


insert ::
   (Name.Attribute name) =>
   Name name ->
   string ->
   ([T name string] -> [T name string])
insert :: forall name string.
Attribute name =>
Name name -> string -> [T name string] -> [T name string]
insert = forall name string.
Attribute name =>
(string -> string -> string)
-> Name name -> string -> [T name string] -> [T name string]
insertWith forall a b. a -> b -> a
const

{- |
Insert an attribute into an attribute list.
If an attribute with the same name is already present,
then the value of this attribute is changed to @f newValue oldValue@.
The function name is analogous to Data.Map.
-}
insertWith ::
   (Name.Attribute name) =>
   (string -> string -> string) ->
   Name name ->
   string ->
   ([T name string] -> [T name string])
insertWith :: forall name string.
Attribute name =>
(string -> string -> string)
-> Name name -> string -> [T name string] -> [T name string]
insertWith string -> string -> string
f Name name
n string
v =
   forall a. (a -> Bool) -> a -> (a -> a) -> [a] -> [a]
updateAppend
      ((Name name
n forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. T name string -> Name name
name_)
      (forall name string. Name name -> string -> T name string
Cons Name name
n string
v)
      (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (string -> string -> string
f string
v))


-- * match attributes

match ::
   (Name.Attribute name, Eq string) =>
   String -> string -> T name string -> Bool
match :: forall name string.
(Attribute name, Eq string) =>
String -> string -> T name string -> Bool
match String
n string
v T name string
attr =
   forall name. C name => String -> name -> Bool
Name.match String
n (forall name string. T name string -> Name name
name_ T name string
attr) Bool -> Bool -> Bool
&& string
v forall a. Eq a => a -> a -> Bool
== forall name string. T name string -> string
value_ T name string
attr

{- |
@matchManyValues name [value0, value1] attrs@
checks whether @(name, value0)@ or @(name, value1)@
is contained in @attrs@.
The values are handled case-sensitive.
-}
matchAnyValue ::
   (Name.Attribute name, Eq string) =>
   String -> [string] -> T name string -> Bool
matchAnyValue :: forall name string.
(Attribute name, Eq string) =>
String -> [string] -> T name string -> Bool
matchAnyValue String
n [string]
vs T name string
attr =
   forall name. C name => String -> name -> Bool
Name.match String
n (forall name string. T name string -> Name name
name_ T name string
attr) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall name string. T name string -> string
value_ T name string
attr) [string]
vs


lookup ::
   (Name.Attribute name) =>
   Name name -> [T name string] -> Maybe string
lookup :: forall name string.
Attribute name =>
Name name -> [T name string] -> Maybe string
lookup Name name
n =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall name string. T name string -> string
value_ forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((Name name
nforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. T name string -> Name name
name_)

lookupLit ::
   (Name.Attribute name) =>
   String -> [T name string] -> Maybe string
lookupLit :: forall name string.
Attribute name =>
String -> [T name string] -> Maybe string
lookupLit String
n =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall name string. T name string -> string
value_ forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (forall name. C name => String -> name -> Bool
Name.match String
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. T name string -> Name name
name_)


any :: (T name string -> Bool) -> [T name string] -> Bool
any :: forall name string.
(T name string -> Bool) -> [T name string] -> Bool
any = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.any

anyName :: (Name name -> Bool) -> [T name string] -> Bool
anyName :: forall name string. (Name name -> Bool) -> [T name string] -> Bool
anyName Name name -> Bool
p = forall name string.
(T name string -> Bool) -> [T name string] -> Bool
any (Name name -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. T name string -> Name name
name_)

anyValue :: (string -> Bool) -> [T name string] -> Bool
anyValue :: forall string name. (string -> Bool) -> [T name string] -> Bool
anyValue string -> Bool
p = forall name string.
(T name string -> Bool) -> [T name string] -> Bool
any (string -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. T name string -> string
value_)


anyLit ::
   (Name.Attribute name, Eq string) =>
   String -> string -> [T name string] -> Bool
anyLit :: forall name string.
(Attribute name, Eq string) =>
String -> string -> [T name string] -> Bool
anyLit String
n string
v = forall name string.
(T name string -> Bool) -> [T name string] -> Bool
any (forall name string.
(Attribute name, Eq string) =>
String -> string -> T name string -> Bool
match String
n string
v)

anyNameLit ::
   (Name.Attribute name) =>
   String -> [T name string] -> Bool
anyNameLit :: forall name string.
Attribute name =>
String -> [T name string] -> Bool
anyNameLit String
n = forall name string. (Name name -> Bool) -> [T name string] -> Bool
anyName (forall name. C name => String -> name -> Bool
Name.match String
n)

anyValueLit :: (Eq string) => string -> [T name string] -> Bool
anyValueLit :: forall string name. Eq string => string -> [T name string] -> Bool
anyValueLit string
v = forall string name. (string -> Bool) -> [T name string] -> Bool
anyValue (string
vforall a. Eq a => a -> a -> Bool
==)