{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
module Distribution.Types.MungedPackageName
  ( MungedPackageName (..)
  , decodeCompatPackageName
  , encodeCompatPackageName
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
import Distribution.Types.PackageName
import Distribution.Types.UnqualComponentName

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp

-- | A combination of a package and component name used in various legacy
-- interfaces, chiefly bundled with a version as 'MungedPackageId'. It's generally
-- better to use a 'UnitId' to opaquely refer to some compilation/packing unit,
-- but that doesn't always work, e.g. where a "name" is needed, in which case
-- this can be used as a fallback.
--
-- Use 'mkMungedPackageName' and 'unMungedPackageName' to convert from/to a 'String'.
--
-- In @3.0.0.0@ representation was changed from opaque (string) to semantic representation.
--
-- @since 2.0.0.2
--
data MungedPackageName = MungedPackageName !PackageName !LibraryName
  deriving ((forall x. MungedPackageName -> Rep MungedPackageName x)
-> (forall x. Rep MungedPackageName x -> MungedPackageName)
-> Generic MungedPackageName
forall x. Rep MungedPackageName x -> MungedPackageName
forall x. MungedPackageName -> Rep MungedPackageName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MungedPackageName x -> MungedPackageName
$cfrom :: forall x. MungedPackageName -> Rep MungedPackageName x
Generic, ReadPrec [MungedPackageName]
ReadPrec MungedPackageName
Int -> ReadS MungedPackageName
ReadS [MungedPackageName]
(Int -> ReadS MungedPackageName)
-> ReadS [MungedPackageName]
-> ReadPrec MungedPackageName
-> ReadPrec [MungedPackageName]
-> Read MungedPackageName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MungedPackageName]
$creadListPrec :: ReadPrec [MungedPackageName]
readPrec :: ReadPrec MungedPackageName
$creadPrec :: ReadPrec MungedPackageName
readList :: ReadS [MungedPackageName]
$creadList :: ReadS [MungedPackageName]
readsPrec :: Int -> ReadS MungedPackageName
$creadsPrec :: Int -> ReadS MungedPackageName
External instance of the constraint type Read LibraryName
External instance of the constraint type Read PackageName
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read MungedPackageName
Read, Int -> MungedPackageName -> ShowS
[MungedPackageName] -> ShowS
MungedPackageName -> String
(Int -> MungedPackageName -> ShowS)
-> (MungedPackageName -> String)
-> ([MungedPackageName] -> ShowS)
-> Show MungedPackageName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MungedPackageName] -> ShowS
$cshowList :: [MungedPackageName] -> ShowS
show :: MungedPackageName -> String
$cshow :: MungedPackageName -> String
showsPrec :: Int -> MungedPackageName -> ShowS
$cshowsPrec :: Int -> MungedPackageName -> ShowS
External instance of the constraint type Show LibraryName
External instance of the constraint type Show PackageName
External instance of the constraint type Ord Int
Show, MungedPackageName -> MungedPackageName -> Bool
(MungedPackageName -> MungedPackageName -> Bool)
-> (MungedPackageName -> MungedPackageName -> Bool)
-> Eq MungedPackageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MungedPackageName -> MungedPackageName -> Bool
$c/= :: MungedPackageName -> MungedPackageName -> Bool
== :: MungedPackageName -> MungedPackageName -> Bool
$c== :: MungedPackageName -> MungedPackageName -> Bool
External instance of the constraint type Eq LibraryName
External instance of the constraint type Eq PackageName
Eq, Eq MungedPackageName
Eq MungedPackageName
-> (MungedPackageName -> MungedPackageName -> Ordering)
-> (MungedPackageName -> MungedPackageName -> Bool)
-> (MungedPackageName -> MungedPackageName -> Bool)
-> (MungedPackageName -> MungedPackageName -> Bool)
-> (MungedPackageName -> MungedPackageName -> Bool)
-> (MungedPackageName -> MungedPackageName -> MungedPackageName)
-> (MungedPackageName -> MungedPackageName -> MungedPackageName)
-> Ord MungedPackageName
MungedPackageName -> MungedPackageName -> Bool
MungedPackageName -> MungedPackageName -> Ordering
MungedPackageName -> MungedPackageName -> MungedPackageName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MungedPackageName -> MungedPackageName -> MungedPackageName
$cmin :: MungedPackageName -> MungedPackageName -> MungedPackageName
max :: MungedPackageName -> MungedPackageName -> MungedPackageName
$cmax :: MungedPackageName -> MungedPackageName -> MungedPackageName
>= :: MungedPackageName -> MungedPackageName -> Bool
$c>= :: MungedPackageName -> MungedPackageName -> Bool
> :: MungedPackageName -> MungedPackageName -> Bool
$c> :: MungedPackageName -> MungedPackageName -> Bool
<= :: MungedPackageName -> MungedPackageName -> Bool
$c<= :: MungedPackageName -> MungedPackageName -> Bool
< :: MungedPackageName -> MungedPackageName -> Bool
$c< :: MungedPackageName -> MungedPackageName -> Bool
compare :: MungedPackageName -> MungedPackageName -> Ordering
$ccompare :: MungedPackageName -> MungedPackageName -> Ordering
External instance of the constraint type Ord LibraryName
External instance of the constraint type Ord PackageName
Instance of class: Eq of the constraint type Eq MungedPackageName
Instance of class: Ord of the constraint type Ord MungedPackageName
Instance of class: Eq of the constraint type Eq MungedPackageName
Ord, Typeable, Typeable MungedPackageName
DataType
Constr
Typeable MungedPackageName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> MungedPackageName
    -> c MungedPackageName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MungedPackageName)
-> (MungedPackageName -> Constr)
-> (MungedPackageName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MungedPackageName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MungedPackageName))
-> ((forall b. Data b => b -> b)
    -> MungedPackageName -> MungedPackageName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MungedPackageName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MungedPackageName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MungedPackageName -> m MungedPackageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MungedPackageName -> m MungedPackageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MungedPackageName -> m MungedPackageName)
-> Data MungedPackageName
MungedPackageName -> DataType
MungedPackageName -> Constr
(forall b. Data b => b -> b)
-> MungedPackageName -> MungedPackageName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MungedPackageName -> c MungedPackageName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MungedPackageName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> MungedPackageName -> u
forall u. (forall d. Data d => d -> u) -> MungedPackageName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MungedPackageName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MungedPackageName -> c MungedPackageName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MungedPackageName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MungedPackageName)
$cMungedPackageName :: Constr
$tMungedPackageName :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
gmapMp :: (forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
gmapM :: (forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MungedPackageName -> m MungedPackageName
gmapQi :: Int -> (forall d. Data d => d -> u) -> MungedPackageName -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MungedPackageName -> u
gmapQ :: (forall d. Data d => d -> u) -> MungedPackageName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MungedPackageName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MungedPackageName -> r
gmapT :: (forall b. Data b => b -> b)
-> MungedPackageName -> MungedPackageName
$cgmapT :: (forall b. Data b => b -> b)
-> MungedPackageName -> MungedPackageName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MungedPackageName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MungedPackageName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MungedPackageName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MungedPackageName)
dataTypeOf :: MungedPackageName -> DataType
$cdataTypeOf :: MungedPackageName -> DataType
toConstr :: MungedPackageName -> Constr
$ctoConstr :: MungedPackageName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MungedPackageName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MungedPackageName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MungedPackageName -> c MungedPackageName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MungedPackageName -> c MungedPackageName
External instance of the constraint type Data PackageName
External instance of the constraint type Data LibraryName
Data)

instance Binary MungedPackageName
instance Structured MungedPackageName
instance NFData MungedPackageName where rnf :: MungedPackageName -> ()
rnf = MungedPackageName -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData PackageName
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData LibraryName
Instance of class: Generic of the constraint type Generic MungedPackageName
genericRnf

-- | Computes the package name for a library.  If this is the public
-- library, it will just be the original package name; otherwise,
-- it will be a munged package name recording the original package
-- name as well as the name of the internal library.
--
-- A lot of tooling in the Haskell ecosystem assumes that if something
-- is installed to the package database with the package name 'foo',
-- then it actually is an entry for the (only public) library in package
-- 'foo'.  With internal packages, this is not necessarily true:
-- a public library as well as arbitrarily many internal libraries may
-- come from the same package.  To prevent tools from getting confused
-- in this case, the package name of these internal libraries is munged
-- so that they do not conflict the public library proper.  A particular
-- case where this matters is ghc-pkg: if we don't munge the package
-- name, the inplace registration will OVERRIDE a different internal
-- library.
--
-- We munge into a reserved namespace, "z-", and encode both the
-- component name and the package name of an internal library using the
-- following format:
--
--      compat-pkg-name ::= "z-" package-name "-z-" library-name
--
-- where package-name and library-name have "-" ( "z" + ) "-"
-- segments encoded by adding an extra "z".
--
-- When we have the public library, the compat-pkg-name is just the
-- package-name, no surprises there!
--
-- >>> prettyShow $ MungedPackageName "servant" LMainLibName
-- "servant"
--
-- >>> prettyShow $ MungedPackageName "servant" (LSubLibName "lackey")
-- "z-servant-z-lackey"
--
instance Pretty MungedPackageName where
    -- First handle the cases where we can just use the original 'PackageName'.
    -- This is for the PRIMARY library, and it is non-Backpack, or the
    -- indefinite package for us.
    pretty :: MungedPackageName -> Doc
pretty = String -> Doc
Disp.text (String -> Doc)
-> (MungedPackageName -> String) -> MungedPackageName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MungedPackageName -> String
encodeCompatPackageName'

-- |
--
-- >>> simpleParsec "servant" :: Maybe MungedPackageName
-- Just (MungedPackageName (PackageName "servant") LMainLibName)
--
-- >>> simpleParsec "z-servant-z-lackey" :: Maybe MungedPackageName
-- Just (MungedPackageName (PackageName "servant") (LSubLibName (UnqualComponentName "lackey")))
--
-- >>> simpleParsec "z-servant-zz" :: Maybe MungedPackageName
-- Just (MungedPackageName (PackageName "z-servant-zz") LMainLibName)
--
instance Parsec MungedPackageName where
    parsec :: m MungedPackageName
parsec = String -> MungedPackageName
decodeCompatPackageName' (String -> MungedPackageName) -> m String -> m MungedPackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m String
forall (m :: * -> *). CabalParsing m => m String
Evidence bound by a type signature of the constraint type CabalParsing m
parsecUnqualComponentName

-------------------------------------------------------------------------------
-- ZDashCode conversions
-------------------------------------------------------------------------------

-- | Intended for internal use only
--
-- >>> decodeCompatPackageName "z-servant-z-lackey"
-- MungedPackageName (PackageName "servant") (LSubLibName (UnqualComponentName "lackey"))
--
decodeCompatPackageName :: PackageName -> MungedPackageName
decodeCompatPackageName :: PackageName -> MungedPackageName
decodeCompatPackageName = String -> MungedPackageName
decodeCompatPackageName' (String -> MungedPackageName)
-> (PackageName -> String) -> PackageName -> MungedPackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName

-- | Intended for internal use only
--
-- >>> encodeCompatPackageName $ MungedPackageName "servant" (LSubLibName "lackey")
-- PackageName "z-servant-z-lackey"
--
-- This is used in @cabal-install@ in the Solver.
-- May become obsolete as solver moves to per-component solving.
--
encodeCompatPackageName :: MungedPackageName -> PackageName
encodeCompatPackageName :: MungedPackageName -> PackageName
encodeCompatPackageName = String -> PackageName
mkPackageName (String -> PackageName)
-> (MungedPackageName -> String)
-> MungedPackageName
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MungedPackageName -> String
encodeCompatPackageName'

decodeCompatPackageName' :: String -> MungedPackageName
decodeCompatPackageName' :: String -> MungedPackageName
decodeCompatPackageName' String
m =
    case String
m of
        Char
'z':Char
'-':String
rest | Right [String
pn, String
cn] <- ParsecParser [String] -> String -> Either String [String]
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser [String]
forall (m :: * -> *). CabalParsing m => m [String]
External instance of the constraint type CabalParsing ParsecParser
parseZDashCode String
rest
            -> PackageName -> LibraryName -> MungedPackageName
MungedPackageName (String -> PackageName
mkPackageName String
pn) (UnqualComponentName -> LibraryName
LSubLibName (String -> UnqualComponentName
mkUnqualComponentName String
cn))
        String
s   -> PackageName -> LibraryName -> MungedPackageName
MungedPackageName (String -> PackageName
mkPackageName String
s) LibraryName
LMainLibName

encodeCompatPackageName' :: MungedPackageName -> String
encodeCompatPackageName' :: MungedPackageName -> String
encodeCompatPackageName' (MungedPackageName PackageName
pn LibraryName
LMainLibName)      = PackageName -> String
unPackageName PackageName
pn
encodeCompatPackageName' (MungedPackageName PackageName
pn (LSubLibName UnqualComponentName
uqn)) =
     String
"z-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
zdashcode (PackageName -> String
unPackageName PackageName
pn) String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"-z-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
zdashcode (UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
uqn)

zdashcode :: String -> String
zdashcode :: ShowS
zdashcode String
s = String -> Maybe Int -> ShowS
forall {a}. (Ord a, Num a) => String -> Maybe a -> ShowS
External instance of the constraint type Num Int
External instance of the constraint type Ord Int
go String
s (Maybe Int
forall a. Maybe a
Nothing :: Maybe Int) []
    where go :: String -> Maybe a -> ShowS
go [] Maybe a
_ String
r = ShowS
forall a. [a] -> [a]
reverse String
r
          go (Char
'-':String
z) (Just a
n) String
r | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Ord a
> a
0 = String -> Maybe a -> ShowS
go String
z (a -> Maybe a
forall a. a -> Maybe a
Just a
0) (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'z'Char -> ShowS
forall a. a -> [a] -> [a]
:String
r)
          go (Char
'-':String
z) Maybe a
_        String
r = String -> Maybe a -> ShowS
go String
z (a -> Maybe a
forall a. a -> Maybe a
Just a
0) (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:String
r)
          go (Char
'z':String
z) (Just a
n) String
r = String -> Maybe a -> ShowS
go String
z (a -> Maybe a
forall a. a -> Maybe a
Just (a
na -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
+a
1)) (Char
'z'Char -> ShowS
forall a. a -> [a] -> [a]
:String
r)
          go (Char
c:String
z)   Maybe a
_        String
r = String -> Maybe a -> ShowS
go String
z Maybe a
forall a. Maybe a
Nothing (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
r)

parseZDashCode :: CabalParsing m => m [String]
parseZDashCode :: m [String]
parseZDashCode = do
    [String]
ns <- NonEmpty String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
External instance of the constraint type Foldable NonEmpty
toList (NonEmpty String -> [String]) -> m (NonEmpty String) -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m String -> m Char -> m (NonEmpty String)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.sepByNonEmpty (m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
some ((Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
/= Char
'-'))) (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.char Char
'-')
    [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return ([String] -> [String]
go [String]
ns)
  where
    go :: [String] -> [String]
go [String]
ns = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
==String
"z") [String]
ns of
                ([String]
_, []) -> [[String] -> String
paste [String]
ns]
                ([String]
as, String
"z":[String]
bs) -> [String] -> String
paste [String]
as String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
go [String]
bs
                ([String], [String])
_ -> String -> [String]
forall a. HasCallStack => String -> a
error String
"parseZDashCode: go"
    unZ :: String -> String
    unZ :: ShowS
unZ String
"" = ShowS
forall a. HasCallStack => String -> a
error String
"parseZDashCode: unZ"
    unZ r :: String
r@(Char
'z':String
zs) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
External instance of the constraint type Foldable []
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
==Char
'z') String
zs = String
zs
                   | Bool
otherwise      = String
r
    unZ String
r = String
r
    paste :: [String] -> String
    paste :: [String] -> String
paste = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" ([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
unZ

-- $setup
-- >>> :seti -XOverloadedStrings