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