module Text.XML.HaXml.Schema.NameConversion
( module Text.XML.HaXml.Schema.NameConversion
) where
import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces
import Data.Char
import Data.List
newtype XName = XName QName
deriving (XName -> XName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XName -> XName -> Bool
$c/= :: XName -> XName -> Bool
== :: XName -> XName -> Bool
$c== :: XName -> XName -> Bool
Eq,Int -> XName -> ShowS
[XName] -> ShowS
XName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XName] -> ShowS
$cshowList :: [XName] -> ShowS
show :: XName -> String
$cshow :: XName -> String
showsPrec :: Int -> XName -> ShowS
$cshowsPrec :: Int -> XName -> ShowS
Show)
newtype HName = HName String
deriving Int -> HName -> ShowS
[HName] -> ShowS
HName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HName] -> ShowS
$cshowList :: [HName] -> ShowS
show :: HName -> String
$cshow :: HName -> String
showsPrec :: Int -> HName -> ShowS
$cshowsPrec :: Int -> HName -> ShowS
Show
data NameConverter = NameConverter
{ NameConverter -> XName -> HName
modid :: XName -> HName
, NameConverter -> XName -> HName
conid :: XName -> HName
, NameConverter -> XName -> HName
varid :: XName -> HName
, NameConverter -> XName -> HName
unqconid :: XName -> HName
, NameConverter -> XName -> HName
unqvarid :: XName -> HName
, NameConverter -> XName -> HName
fwdconid :: XName -> HName
, NameConverter -> XName -> XName -> HName
fieldid :: XName -> XName -> HName
}
simpleNameConverter :: NameConverter
simpleNameConverter :: NameConverter
simpleNameConverter = NameConverter
{ modid :: XName -> HName
modid = \(XName QName
qn)-> String -> HName
HName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
mkConid forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
hierarchy forall a b. (a -> b) -> a -> b
$ QName
qn
, conid :: XName -> HName
conid = \(XName QName
qn)-> String -> HName
HName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
mkConid forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
hierarchy forall a b. (a -> b) -> a -> b
$ QName
qn
, varid :: XName -> HName
varid = \(XName QName
qn)-> String -> HName
HName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
mkVarid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> a) -> [a] -> [a]
last ShowS
avoidKeywords
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
hierarchy forall a b. (a -> b) -> a -> b
$ QName
qn
, unqconid :: XName -> HName
unqconid = \(XName QName
qn)-> String -> HName
HName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
mkConid forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
local forall a b. (a -> b) -> a -> b
$ QName
qn
, unqvarid :: XName -> HName
unqvarid = \(XName QName
qn)-> String -> HName
HName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
mkVarid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> a) -> [a] -> [a]
last ShowS
avoidKeywords
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
local forall a b. (a -> b) -> a -> b
$ QName
qn
, fwdconid :: XName -> HName
fwdconid = \(XName QName
qn)-> String -> HName
HName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Fwd"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
mkConid forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
local forall a b. (a -> b) -> a -> b
$ QName
qn
, fieldid :: XName -> XName -> HName
fieldid = \(XName QName
qnt) (XName QName
qnf)->
String -> HName
HName forall a b. (a -> b) -> a -> b
$ ([String] -> String
mkVarid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> a) -> [a] -> [a]
last forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
hierarchy forall a b. (a -> b) -> a -> b
$ QName
qnt)
forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++
([String] -> String
mkVarid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> a) -> [a] -> [a]
last forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
hierarchy forall a b. (a -> b) -> a -> b
$ QName
qnf)
}
where
hierarchy :: QName -> [String]
hierarchy (N String
n) = forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (forall a. Eq a => a -> a -> Bool
==Char
':') String
n
hierarchy (QN Namespace
ns String
n) = [Namespace -> String
nsPrefix Namespace
ns, String
n]
local :: QName -> [String]
local = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
Prelude.last forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
hierarchy
mkConid :: [String] -> String
mkConid [] = String
"Empty"
mkConid [String
c] | forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c forall a. Eq a => a -> a -> Bool
== String
"string" = String
"Xsd.XsdString"
| Bool
otherwise = (Char -> Char) -> ShowS
first Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
escape String
c
mkConid [String
m,String
c] | forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c forall a. Eq a => a -> a -> Bool
== String
"string" = String
"Xsd.XsdString"
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c forall a. Eq a => a -> a -> Bool
== String
"date" = String
"Xsd.Date"
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c forall a. Eq a => a -> a -> Bool
== String
"double" = String
"Xsd.Double"
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c forall a. Eq a => a -> a -> Bool
== String
"integer" = String
"Xsd.Integer"
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c forall a. Eq a => a -> a -> Bool
== String
"boolean" = String
"Xsd.Boolean"
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c forall a. Eq a => a -> a -> Bool
== String
"decimal" = String
"Xsd.Decimal"
| Bool
otherwise = (Char -> Char) -> ShowS
first Char -> Char
toUpper String
mforall a. [a] -> [a] -> [a]
++String
"."forall a. [a] -> [a] -> [a]
++(Char -> Char) -> ShowS
first Char -> Char
toUpper (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
escape String
c)
mkConid [String]
more = [String] -> String
mkConid [forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
more]
mkVarid :: [String] -> String
mkVarid [String
v] = (Char -> Char) -> ShowS
first Char -> Char
toLower (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
escape String
v)
mkVarid [String
m,String
v] = (Char -> Char) -> ShowS
first Char -> Char
toUpper String
mforall a. [a] -> [a] -> [a]
++String
"."forall a. [a] -> [a] -> [a]
++(Char -> Char) -> ShowS
first Char -> Char
toLower (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
escape String
v)
first :: (Char -> Char) -> ShowS
first Char -> Char
f (Char
x:String
xs)
| Bool -> Bool
not (Char -> Bool
isAlpha Char
x) = Char -> Char
f Char
'v'forall a. a -> [a] -> [a]
: Char
xforall a. a -> [a] -> [a]
: String
xs
| Bool
otherwise = Char -> Char
f Char
xforall a. a -> [a] -> [a]
: String
xs
last :: (a -> a) -> [a] -> [a]
last a -> a
f [a
x] = [ a -> a
f a
x ]
last a -> a
f (a
x:[a]
xs) = a
xforall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
last a -> a
f [a]
xs
escape :: Char -> Char
escape :: Char -> Char
escape Char
x | Char
xforall a. Eq a => a -> a -> Bool
==Char
' ' = Char
'_'
| Char
xforall a. Eq a => a -> a -> Bool
==Char
'_' = Char
'_'
| Char -> Bool
isAlphaNum Char
x = Char
x
| Bool
otherwise = Char
'\''
avoidKeywords :: String -> String
avoidKeywords :: ShowS
avoidKeywords String
s
| String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
keywords = String
sforall a. [a] -> [a] -> [a]
++String
"_"
| Bool
otherwise = String
s
where
keywords :: [String]
keywords = [ String
"case", String
"of", String
"data", String
"default", String
"deriving", String
"do"
, String
"forall", String
"foreign", String
"if", String
"then", String
"else", String
"import"
, String
"infix", String
"infixl", String
"infixr", String
"instance", String
"let", String
"in"
, String
"module", String
"newtype", String
"qualified", String
"type", String
"where" ]
fpml :: String -> String
fpml :: ShowS
fpml = forall a. [a] -> [[a]] -> [a]
intercalate String
"."
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Data"forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
rearrange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShowS
cap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (forall a. Eq a => a -> a -> Bool
==Char
'-')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
basename String
".xsd"
where
version :: [String] -> [String]
version [String]
ws = let ([String]
last2,[String]
remain) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [String]
ws in
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) [String]
last2 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ws forall a. Ord a => a -> a -> Bool
> Int
2
then forall a. [a] -> a
head [String]
wsforall a. a -> [a] -> [a]
: (Char
'V'forall a. a -> [a] -> [a]
:forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [a] -> [a]
reverse [String]
last2))
forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail (forall a. [a] -> [a]
reverse [String]
remain)
else [String]
ws
rearrange :: [String] -> [String]
rearrange [String
a,String
v,String
"PostTrade",String
c] = [String
a,String
v,String
"PostTrade",String
c]
rearrange [String
a,String
v,String
b,String
c] = [String
a,String
v,String
c,String
b]
rearrange [String
a,String
v,String
b,String
c,String
d] = [String
a,String
v,String
d,String
bforall a. [a] -> [a] -> [a]
++String
c]
rearrange [String
a,String
v,String
b,String
c,String
d,String
e] = [String
a,String
v,String
e,String
bforall a. [a] -> [a] -> [a]
++String
cforall a. [a] -> [a] -> [a]
++String
d]
rearrange [String]
v = [String]
v
cap :: String -> String
cap :: ShowS
cap String
"Fpml" = String
"FpML"
cap String
"fpml" = String
"FpML"
cap String
"cd" = String
"CD"
cap String
"eq" = String
"EQ"
cap String
"fx" = String
"FX"
cap String
"ird" = String
"IRD"
cap String
"posttrade" = String
"PostTrade"
cap String
"pretrade" = String
"PreTrade"
cap (Char
c:String
cs) = Char -> Char
toUpper Char
cforall a. a -> [a] -> [a]
: String
cs
wordsBy :: (a->Bool) -> [a] -> [[a]]
wordsBy :: forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
pred = forall {a}. (a -> Bool) -> [a] -> [a] -> [[a]]
wordsBy' a -> Bool
pred []
where wordsBy' :: (a -> Bool) -> [a] -> [a] -> [[a]]
wordsBy' a -> Bool
p [] [] = []
wordsBy' a -> Bool
p [a]
acc [] = [forall a. [a] -> [a]
reverse [a]
acc]
wordsBy' a -> Bool
p [a]
acc (a
c:[a]
cs) | a -> Bool
p a
c = forall a. [a] -> [a]
reverse [a]
acc forall a. a -> [a] -> [a]
:
(a -> Bool) -> [a] -> [a] -> [[a]]
wordsBy' a -> Bool
p [] (forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p [a]
cs)
| Bool
otherwise = (a -> Bool) -> [a] -> [a] -> [[a]]
wordsBy' a -> Bool
p (a
cforall a. a -> [a] -> [a]
:[a]
acc) [a]
cs
basename :: String -> String -> String
basename :: String -> ShowS
basename String
ext = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Eq a => [a] -> [a] -> [a]
snip (forall a. [a] -> [a]
reverse String
ext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`String
"\\/")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
where snip :: [a] -> [a] -> [a]
snip [a]
p [a]
s = if [a]
p forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`[a]
s then forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p) [a]
s else [a]
s
fpmlNameConverter :: NameConverter
fpmlNameConverter :: NameConverter
fpmlNameConverter = NameConverter
simpleNameConverter
{ modid :: XName -> HName
modid = (\(HName String
h)-> String -> HName
HName (ShowS
fpml String
h))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameConverter -> XName -> HName
modid NameConverter
simpleNameConverter
, fwdconid :: XName -> HName
fwdconid = \(XName QName
qn)-> String -> HName
HName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Pseudo"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
mkConId forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
local forall a b. (a -> b) -> a -> b
$ QName
qn
, fieldid :: XName -> XName -> HName
fieldid = \(XName QName
qnt) (XName QName
qnf)->
let t :: String
t = ShowS
mkVarId forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
local forall a b. (a -> b) -> a -> b
$ QName
qnt
f :: String
f = ShowS
mkVarId forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
local forall a b. (a -> b) -> a -> b
$ QName
qnf
in String -> HName
HName forall a b. (a -> b) -> a -> b
$ if String
tforall a. Eq a => a -> a -> Bool
==String
f then String
f
else ShowS
mkVarId (ShowS
shorten (ShowS
mkConId String
t)) forall a. [a] -> [a] -> [a]
++String
"_"forall a. [a] -> [a] -> [a]
++
if String
t forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
f
then ShowS
mkVarId (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t) String
f)
else String
f
}
where
hierarchy :: QName -> [String]
hierarchy (N String
n) = forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (forall a. Eq a => a -> a -> Bool
==Char
':') String
n
hierarchy (QN Namespace
ns String
n) = [Namespace -> String
nsPrefix Namespace
ns, String
n]
local :: QName -> String
local = forall a. [a] -> a
Prelude.last forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [String]
hierarchy
mkVarId :: ShowS
mkVarId String
"id" = String
"ID"
mkVarId (Char
v:String
vs) = Char -> Char
toLower Char
vforall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
escape String
vs
mkConId :: ShowS
mkConId (Char
v:String
vs) = Char -> Char
toUpper Char
vforall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
escape String
vs
shorten :: ShowS
shorten String
t | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t forall a. Ord a => a -> a -> Bool
<= Int
12 = String
t
| forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t forall a. Ord a => a -> a -> Bool
< Int
35 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ShowS
shortenWord (String -> [String]
splitWords String
t)
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall a. [a] -> a
head String
tforall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isUpper (forall a. [a] -> [a]
tail String
t))
splitWords :: String -> [String]
splitWords String
"" = []
splitWords (Char
u:String
s) = let (String
w,String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\Char
c->Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char
cforall a. Eq a => a -> a -> Bool
==Char
'_') String
s
in (Char
uforall a. a -> [a] -> [a]
:String
w) forall a. a -> [a] -> [a]
: String -> [String]
splitWords String
rest
shortenWord :: ShowS
shortenWord String
"Request" = String
"Req"
shortenWord String
"Reference" = String
"Ref"
shortenWord String
"Valuation" = String
"Val"
shortenWord String
"Calendar" = String
"Cal"
shortenWord String
"Absolute" = String
"Abs"
shortenWord String
"Additional" = String
"Add"
shortenWord String
"Business" = String
"Bus"
shortenWord String
"Standard" = String
"Std"
shortenWord String
"Calculation" = String
"Calc"
shortenWord String
"Quotation" = String
"Quot"
shortenWord String
"Information" = String
"Info"
shortenWord String
"Exchange" = String
"Exch"
shortenWord String
"Characteristics" = String
"Char"
shortenWord String
"Multiple" = String
"Multi"
shortenWord String
"Constituent" = String
"Constit"
shortenWord String
"Convertible" = String
"Convert"
shortenWord String
"Underlyer" = String
"Underly"
shortenWord String
"Underlying" = String
"Underly"
shortenWord String
"Properties" = String
"Props"
shortenWord String
"Property" = String
"Prop"
shortenWord String
"Affirmation" = String
"Affirmation"
shortenWord String
"Affirmed" = String
"Affirmed"
shortenWord String
"KnockIn" = String
"KnockIn"
shortenWord String
"Knockin" = String
"Knockin"
shortenWord String
"KnockOut" = String
"KnockOut"
shortenWord String
"Knockout" = String
"Knockout"
shortenWord String
w | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w forall a. Ord a => a -> a -> Bool
< Int
8 = String
w
| Bool
otherwise = case forall a. Int -> [a] -> ([a], [a])
splitAt Int
5 String
w of
(String
pref,Char
c:String
suf) | Char -> Bool
isVowel Char
c -> String
pref
| Bool
otherwise -> String
prefforall a. [a] -> [a] -> [a]
++[Char
c]
isVowel :: Char -> Bool
isVowel = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"aeiouy")