    -- | A type model for Haskell datatypes that bears a reasonable correspondence
    --   to the XSD type model.
    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

    -- | An XName just holds the original XSD qualified name.  It does not
    --   ensure that the string conforms to any rules of the various Haskell
    --   namespaces.  Use a NameConverter to define how you would like names
    --   to be mangled.
    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
    $c== :: XName -> XName -> Bool
    == :: XName -> XName -> Bool
    $c/= :: XName -> XName -> Bool
    /= :: 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
    $cshowsPrec :: Int -> XName -> ShowS
    showsPrec :: Int -> XName -> ShowS
    $cshow :: XName -> String
    show :: XName -> String
    $cshowList :: [XName] -> ShowS
    showList :: [XName] -> ShowS
    Show)

    -- | An HName is a resolved version of an XName.  It should conform to
    --   the various namespace rules, and may already include a module
    --   qualifier if appropriate.
    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
    $cshowsPrec :: Int -> HName -> ShowS
    showsPrec :: Int -> HName -> ShowS
    $cshow :: HName -> String
    show :: HName -> String
    $cshowList :: [HName] -> ShowS
    showList :: [HName] -> ShowS
    Show

    -- | A NameConverter is a collection of functions that convert an XName
    --   into an HName, for various Haskell namespaces.  You can define your
    --   own arbitrary resolver, but should ensure that you abide by the
    --   Haskell rules for conid, varid, etc.
    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  -- ^ for forward type decls
                           , NameConverter -> XName -> XName -> HName
    fieldid  :: XName -> XName -> HName
                           }

    -- | A simple default set of rules for resolving XNames into HNames.
    simpleNameConverter :: NameConverter
    simpleNameConverter :: NameConverter
    simpleNameConverter = NameConverter
        { modid :: XName -> HName
    modid    = \(XName 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 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 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 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 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 QName
    qn)-> String -> HName
    HName (String -> HName) -> (QName -> String) -> QName -> HName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "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 QName
    qnt) (XName 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
    "_" 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 String
    n)     = (Char -> Bool) -> String -> [String]
    forall a. (a -> Bool) -> [a] -> [[a]]
    wordsBy (Char -> Char -> Bool
    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               = (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. HasCallStack => [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  []         = String
    "Empty"
        mkConid  [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
    "string"     = 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 [String
    m,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
    "string"     = 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
    == String
    "date"       = String
    "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
    == String
    "double"     = String
    "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
    == String
    "integer"    = String
    "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
    == String
    "boolean"    = String
    "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
    == String
    "decimal"    = String
    "Xsd.Decimal"
                            | Bool
    otherwise = (Char -> Char) -> ShowS
    first Char -> Char
    toUpper ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    escape String
    m)String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "."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 [String]
    more        = [String] -> String
    mkConid [[String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    more]
        mkVarid :: [String] -> String
    mkVarid  [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 [String
    m,String
    v]       = (Char -> Char) -> ShowS
    first Char -> Char
    toUpper String
    mString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "."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 Char -> Char
    f (Char
    x:String
    xs)
          | Bool -> Bool
    not (Char -> Bool
    isAlpha Char
    x) = Char -> Char
    f Char
    '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  a -> a
    f [a
    x]         = [ a -> a
    f a
    x ]
        last  a -> a
    f (a
    x:[a]
    xs)      = a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> a) -> [a] -> [a]
    last a -> a
    f [a]
    xs

    -- | Character escapes to create a valid Haskell identifier.
    escape :: Char -> Char
    escape :: Char -> Char
    escape Char
    x | Char
    xChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ' '       = Char
    '_'
             | Char
    xChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '_'       = Char
    '_'
             | Char -> Bool
    isAlphaNum Char
    x = Char
    x
             | Bool
    otherwise    = Char
    '\''

     -- cleanUp = map (\c-> if not (isAlphaNum c) then '_' else c)

    -- | Ensure that a string does not match a Haskell keyword.
    avoidKeywords :: String -> String
    avoidKeywords :: ShowS
    avoidKeywords String
    s
        | String
    s String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    keywords  = String
    sString -> ShowS
    forall 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" ]

    -- | A specialised module-name converter for FpML module names with
    --   multiple dashes, including version numbers,
    --   e.g. fpml-dividend-swaps-4-7.xsd      becomes FpML.V47.Swaps.Dividend
    --   but  fpml-posttrade-execution-4-7.xsd becomes FpML.V47.PostTrade.Execution
    fpml :: String -> String
    fpml :: ShowS
    fpml = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "."        -- put the dots in
             ([String] -> String) -> (String -> [String]) -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "Data"String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :)          -- root of the Haskell module namespace
             ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    rearrange          -- hierarchy shuffling, dependent on names
             ([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            -- make into nice module names
             ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    version            -- move version number to front
             ([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
    ==Char
    '-')    -- separate words
             (String -> [String]) -> ShowS -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    basename String
    ".xsd"    -- strip .xsd if present
      where
        version :: [String] -> [String]
    version [String]
    ws = let ([String]
    last2,[String]
    remain) = Int -> [String] -> ([String], [String])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    ws Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    2
                     then [String] -> String
    forall a. HasCallStack => [a] -> a
    head [String]
    wsString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (Char
    '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. HasCallStack => [a] -> [a]
    tail ([String] -> [String]
    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
    bString -> ShowS
    forall 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
    bString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    cString -> ShowS
    forall 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
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    : String
    cs

    -- | Chop a list into segments, at separators identified by the predicate.
    --   The separator items are discarded.
    wordsBy :: (a->Bool) -> [a] -> [[a]]
    wordsBy :: forall a. (a -> Bool) -> [a] -> [[a]]
    wordsBy 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' a -> Bool
    p []  []     = []
            wordsBy' a -> Bool
    p [a]
    acc []     = [[a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    acc]
            wordsBy' a -> Bool
    p [a]
    acc (a
    c:[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

    -- | Remove any prefix directory names, and given suffix extension.
    basename :: String -> String -> String
    basename :: String -> ShowS
    basename 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 a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`String
    "\\/")) 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 [a]
    p [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 a. [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   = (\(HName String
    h)-> String -> HName
    HName (ShowS
    fpml String
    h))
                    . modid simpleNameConverter
     -- , conid   = (\(HName h)-> case take 4 (reverse h) of
     --                             "munE" -> HName (reverse (drop 4 (reverse h)))
     --                             _      -> HName h )
     --             . conid simpleNameConverter
        , fwdconid = \(XName QName
    qn)-> String -> HName
    HName (String -> HName) -> (QName -> String) -> QName -> HName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "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 QName
    qnt) (XName 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
    "_"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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    t) String
    f)
                                      else String
    f
        }
      where
        hierarchy :: QName -> [String]
    hierarchy (N String
    n)     = (Char -> Bool) -> String -> [String]
    forall a. (a -> Bool) -> [a] -> [[a]]
    wordsBy (Char -> Char -> Bool
    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               = [String] -> String
    forall a. HasCallStack => [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"      = String
    "ID"
        mkVarId   (Char
    v: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   (Char
    v: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 String
    t | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    12 = String
    t
                  | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  Int
    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. HasCallStack => [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. HasCallStack => [a] -> [a]
    tail String
    t))
        splitWords :: String -> [String]
    splitWords String
    "" = []
        splitWords (Char
    u:String
    s)  = let (String
    w,String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (\Char
    c->Char -> Bool
    isUpper Char
    c Bool -> Bool -> Bool
    || Char
    cChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '_') 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 String
    "Request"     = String
    "Req" -- some special cases
        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"  -- avoid shortening
        shortenWord String
    "Knockin"     = String
    "Knockin"
        shortenWord String
    "KnockOut"    = String
    "KnockOut"
        shortenWord String
    "Knockout"    = String
    "Knockout"
        shortenWord String
    w | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    8 = String
    w   -- then the general rule
                      | Bool
    otherwise    = case Int -> String -> (String, String)
    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
    prefString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char
    c]

        isVowel :: Char -> Bool
    isVowel = (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "aeiouy")