0N/ADescription : library names for HetCASL and development graphs
0N/ACopyright : (c) Christian Maeder, DFKI GmbH 2008
0N/AMaintainer : Christian.Maeder@dfki.de
0N/AStability : provisional
0N/APortability : portable
0N/AAbstract syntax of HetCASL specification libraries
0N/A Follows Sect. II:2.2.5 of the CASL Reference Manual.
0N/AomTs = [genToken "OM"]
0N/AmkQualName :: SIMPLE_ID -> LibId -> Id -> Id
0N/AmkQualName nodeId libId i =
0N/A Id omTs [i, simpleIdToId nodeId, libIdToId libId] $ posOfId i
0N/AisQualNameFrom :: SIMPLE_ID -> LibId -> Id -> Bool
0N/AisQualNameFrom nodeId libId i@(Id _ cs _) = case cs of
0N/A _ : n : l : _ | isQualName i ->
0N/A n == simpleIdToId nodeId && libIdToId libId == l
0N/AisQualName :: Id -> Bool
0N/AisQualName (Id ts cs _) = case cs of
0N/A _ : _ : _ -> ts == omTs
0N/AlibIdOfQualName :: Id -> Id
0N/AlibIdOfQualName j@(Id _ cs _) = case cs of
0N/A [_, _, i] | isQualName j -> i
1178N/A _ -> error "libIdOfQualName: Check by isQualName before calling getLibId!"
0N/AgetNodeId :: Id -> Id
0N/AgetNodeId j@(Id _ cs _) = case cs of
0N/A [_, i, _] | isQualName j -> i
0N/A _ -> error "Check by isQualName before calling getNodeId!"
0N/AunQualName :: Id -> Id
0N/AunQualName j@(Id _ cs _) = case cs of
0N/A i : _ | isQualName j -> i
0N/AlibIdToId :: LibId -> Id
0N/A path = splitOn '/' $ show li
0N/A toTok s = Token s $ getRange li
1178N/A in mkId $ map toTok $ intersperse "/" path
0N/Adata LibName = LibName
0N/A , libVersion :: Maybe VersionNumber }
1178N/AemptyLibName :: String -> LibName
0N/AemptyLibName s = LibName (IndirectLink s nullRange "") Nothing
0N/Adata LibId = IndirectLink PATH Range FilePath
0N/A -- pos: start of PATH
0N/AupdFilePathOfLibId :: FilePath -> LibId -> LibId
0N/AupdFilePathOfLibId fp (IndirectLink p r _) = IndirectLink p r fp
0N/AsetFilePath :: FilePath -> LibName -> LibName
0N/A ln { getLibId = updFilePathOfLibId fp $ getLibId ln }
0N/AgetFilePath :: LibName -> FilePath
0N/A IndirectLink _ _ fp -> fp
0N/Adata VersionNumber = VersionNumber [String] Range
0N/A -- pos: "version", start of first string
0N/Ainstance GetRange LibId where
0N/A getRange (IndirectLink _ r _) = r
0N/Ainstance Show LibId where
0N/A show (IndirectLink s1 _ _) = s1
0N/Ainstance GetRange LibName where
0N/A getRange = getRange . getLibId
0N/Ainstance Show LibName where
0N/A show = show . hsep . prettyLibName
0N/AprettyVersionNumber :: VersionNumber -> [Doc]
0N/AprettyVersionNumber (VersionNumber v _) =
0N/A [keyword versionS, hcat $ punctuate dot $ map codeToken v]
0N/AprettyLibName :: LibName -> [Doc]
0N/AprettyLibName (LibName i mv) = pretty i : case mv of
0N/A Just v -> prettyVersionNumber v
0N/Ainstance Eq LibId where
0N/A IndirectLink s1 _ _ == IndirectLink s2 _ _ = s1 == s2
0N/Ainstance Ord LibId where
0N/A IndirectLink s1 _ _ <= IndirectLink s2 _ _ = s1 <= s2
0N/Ainstance Eq LibName where
0N/A ln1 == ln2 = compare ln1 ln2 == EQ
0N/Ainstance Ord LibName where
0N/A compare = comparing getLibId
0N/Ainstance Pretty LibName where
0N/A pretty = fsep . prettyLibName
0N/Ainstance Pretty LibId where
0N/A pretty = structId . show
0N/Adata LinkPath a = LinkPath a [(LibId, Node)] deriving (Ord, Eq)
0N/Atype SLinkPath = LinkPath String
0N/AshowSLinkPath :: SLinkPath -> String
0N/AshowSLinkPath (LinkPath x l) = s l where
0N/A s ((_, n) : l1) = show n ++ "/" ++ s l1
0N/Ainstance Show a => Show (LinkPath a) where
0N/A show (LinkPath x l) = showSLinkPath $ LinkPath (show x) l
0N/Ainstance Functor LinkPath where
0N/A fmap f (LinkPath x l) = LinkPath (f x) l
0N/AaddToPath :: LibId -> Node -> LinkPath a -> LinkPath a
0N/AaddToPath libid n (LinkPath x l) = LinkPath x $ (libid, n) : l
0N/AinitPath :: LibId -> Node -> a -> LinkPath a
0N/AinitPath libid n x = LinkPath x [(libid, n)]
0N/AconvertFileToLibStr :: FilePath -> String
0N/AconvertFileToLibStr = mkLibStr . takeBaseName
0N/AstripLibChars :: String -> String
0N/AstripLibChars = filter (\ c -> isAlphaNum c || elem c "'_/")
0N/AmkLibStr :: String -> String
0N/AmkLibStr = dropWhile (== '/') . stripLibChars