module Distribution.Types.MungedPackageName
( MungedPackageName, unMungedPackageName, mkMungedPackageName
, computeCompatPackageName
, decodeCompatPackageName
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Utils.ShortText
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
import Distribution.ParseUtils
import Distribution.Text
import Distribution.Types.PackageName
import Distribution.Types.UnqualComponentName
newtype MungedPackageName = MungedPackageName ShortText
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
unMungedPackageName :: MungedPackageName -> String
unMungedPackageName (MungedPackageName s) = fromShortText s
mkMungedPackageName :: String -> MungedPackageName
mkMungedPackageName = MungedPackageName . toShortText
instance IsString MungedPackageName where
fromString = mkMungedPackageName
instance Binary MungedPackageName
instance Text MungedPackageName where
disp = Disp.text . unMungedPackageName
parse = mkMungedPackageName <$> parsePackageName
instance NFData MungedPackageName where
rnf (MungedPackageName pkg) = rnf pkg
computeCompatPackageName :: PackageName -> Maybe UnqualComponentName -> MungedPackageName
computeCompatPackageName pkg_name Nothing
= mkMungedPackageName $ unPackageName pkg_name
computeCompatPackageName pkg_name (Just uqn)
= mkMungedPackageName $
"z-" ++ zdashcode (unPackageName pkg_name) ++
"-z-" ++ zdashcode (unUnqualComponentName uqn)
decodeCompatPackageName :: MungedPackageName -> (PackageName, Maybe UnqualComponentName)
decodeCompatPackageName m =
case unMungedPackageName m of
'z':'-':rest | [([pn, cn], "")] <- Parse.readP_to_S parseZDashCode rest
-> (mkPackageName pn, Just (mkUnqualComponentName cn))
s -> (mkPackageName s, Nothing)
zdashcode :: String -> String
zdashcode s = go s (Nothing :: Maybe Int) []
where go [] _ r = reverse r
go ('-':z) (Just n) r | n > 0 = go z (Just 0) ('-':'z':r)
go ('-':z) _ r = go z (Just 0) ('-':r)
go ('z':z) (Just n) r = go z (Just (n+1)) ('z':r)
go (c:z) _ r = go z Nothing (c:r)
parseZDashCode :: Parse.ReadP r [String]
parseZDashCode = do
ns <- Parse.sepBy1 (Parse.many1 (Parse.satisfy (/= '-'))) (Parse.char '-')
Parse.eof
return (go ns)
where
go ns = case break (=="z") ns of
(_, []) -> [paste ns]
(as, "z":bs) -> paste as : go bs
_ -> error "parseZDashCode: go"
unZ :: String -> String
unZ "" = error "parseZDashCode: unZ"
unZ r@('z':zs) | all (=='z') zs = zs
| otherwise = r
unZ r = r
paste :: [String] -> String
paste = intercalate "-" . map unZ