{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, OverloadedStrings, Rank2Types, DeriveDataTypeable #-}

module Input.Haddock(parseHoogle, fakePackage, input_haddock_test) where

import Language.Haskell.Exts as HSE
import Data.Char
import Data.List.Extra
import Data.Data
import Input.Item
import General.Util
import Control.DeepSeq
import Control.Monad.Trans.Class
import General.Conduit
import Control.Monad.Extra
import Control.Exception.Extra
import Data.Generics.Uniplate.Data
import General.Str


-- | An entry in the Hoogle DB
data Entry = EPackage PkgName
           | EModule ModName
           | EDecl (Decl ())
             deriving (Typeable Entry
Constr
DataType
Typeable Entry =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Entry -> c Entry)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Entry)
-> (Entry -> Constr)
-> (Entry -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Entry))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry))
-> ((forall b. Data b => b -> b) -> Entry -> Entry)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r)
-> (forall u. (forall d. Data d => d -> u) -> Entry -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Entry -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Entry -> m Entry)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entry -> m Entry)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entry -> m Entry)
-> Data Entry
Entry -> Constr
Entry -> DataType
(forall b. Data b => b -> b) -> Entry -> Entry
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
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) -> Entry -> u
forall u. (forall d. Data d => d -> u) -> Entry -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entry)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
$cEDecl :: Constr
$cEModule :: Constr
$cEPackage :: Constr
$tEntry :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Entry -> m Entry
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
gmapMp :: (forall d. Data d => d -> m d) -> Entry -> m Entry
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
gmapM :: (forall d. Data d => d -> m d) -> Entry -> m Entry
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
gmapQi :: Int -> (forall d. Data d => d -> u) -> Entry -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Entry -> u
gmapQ :: (forall d. Data d => d -> u) -> Entry -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Entry -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
gmapT :: (forall b. Data b => b -> b) -> Entry -> Entry
$cgmapT :: (forall b. Data b => b -> b) -> Entry -> Entry
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Entry)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entry)
dataTypeOf :: Entry -> DataType
$cdataTypeOf :: Entry -> DataType
toConstr :: Entry -> Constr
$ctoConstr :: Entry -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
$cp1Data :: Typeable Entry
Data,Typeable,Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
(Int -> Entry -> ShowS)
-> (Entry -> String) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)


fakePackage :: PkgName -> String -> (Maybe Target, [Item])
fakePackage :: PkgName -> String -> (Maybe Target, [Item])
fakePackage name :: PkgName
name desc :: String
desc = (Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ String
-> Maybe (String, String)
-> Maybe (String, String)
-> String
-> String
-> String
-> Target
Target (PkgName -> String
hackagePackageURL PkgName
name) Maybe (String, String)
forall a. Maybe a
Nothing Maybe (String, String)
forall a. Maybe a
Nothing "package" (PkgName -> String
renderPackage PkgName
name) String
desc, [PkgName -> Item
IPackage PkgName
name])

-- | Given a file name (for errors), feed in lines to the conduit and emit either errors or items
parseHoogle :: Monad m => (String -> m ()) -> URL -> LBStr -> ConduitM i (Maybe Target, [Item]) m ()
parseHoogle :: (String -> m ())
-> String -> LBStr -> ConduitM i (Maybe Target, [Item]) m ()
parseHoogle warning :: String -> m ()
warning url :: String
url body :: LBStr
body = LBStr -> ConduitM i BStr m ()
forall (m :: * -> *) i. Monad m => LBStr -> ConduitM i BStr m ()
sourceLStr LBStr
body ConduitM i BStr m ()
-> ConduitM BStr (Maybe Target, [Item]) m ()
-> ConduitM i (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM BStr BStr m ()
forall (m :: * -> *). Monad m => ConduitM BStr BStr m ()
linesCR ConduitM BStr BStr m ()
-> ConduitM BStr (Maybe Target, [Item]) m ()
-> ConduitM BStr (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Int -> ConduitM BStr (Int, BStr) m ()
forall (m :: * -> *) i a.
(Monad m, Enum i) =>
i -> ConduitM a (i, a) m ()
zipFromC 1 ConduitM BStr (Int, BStr) m ()
-> ConduitM (Int, BStr) (Maybe Target, [Item]) m ()
-> ConduitM BStr (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (String -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
forall (m :: * -> *).
Monad m =>
(String -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
parserC String -> m ()
warning ConduitM (Int, BStr) (Target, Entry) m ()
-> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
-> ConduitM (Int, BStr) (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| String -> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
forall (m :: * -> *).
Monad m =>
String -> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
hierarchyC String
url ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
-> ConduitM (Maybe Target, [Item]) (Maybe Target, [Item]) m ()
-> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((Maybe Target, [Item]) -> (Maybe Target, [Item]))
-> ConduitM (Maybe Target, [Item]) (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (\x :: (Maybe Target, [Item])
x -> (Maybe Target, [Item]) -> ()
forall a. NFData a => a -> ()
rnf (Maybe Target, [Item])
x () -> (Maybe Target, [Item]) -> (Maybe Target, [Item])
forall a b. a -> b -> b
`seq` (Maybe Target, [Item])
x)

parserC :: Monad m => (String -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
parserC :: (String -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
parserC warning :: String -> m ()
warning = [BStr] -> String -> ConduitM (Int, BStr) (Target, Entry) m ()
forall a.
Show a =>
[BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [] ""
    where
        f :: [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f com :: [BStr]
com url :: String
url = do
            Maybe (a, BStr)
x <- ConduitT (a, BStr) (Target, Entry) m (Maybe (a, BStr))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
            Maybe (a, BStr)
-> ((a, BStr) -> ConduitT (a, BStr) (Target, Entry) m ())
-> ConduitT (a, BStr) (Target, Entry) m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (a, BStr)
x (((a, BStr) -> ConduitT (a, BStr) (Target, Entry) m ())
 -> ConduitT (a, BStr) (Target, Entry) m ())
-> ((a, BStr) -> ConduitT (a, BStr) (Target, Entry) m ())
-> ConduitT (a, BStr) (Target, Entry) m ()
forall a b. (a -> b) -> a -> b
$ \(i :: a
i,s :: BStr
s) -> case () of
                _ | Just s :: BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix "-- | " BStr
s -> [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [BStr
s] String
url
                  | Just s :: BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix "--" BStr
s -> [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f (if [BStr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BStr]
com then [] else BStr -> BStr
bstrTrimStart BStr
s BStr -> [BStr] -> [BStr]
forall a. a -> [a] -> [a]
: [BStr]
com) String
url
                  | Just s :: BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix "@url " BStr
s -> [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [BStr]
com (BStr -> String
bstrUnpack BStr
s)
                  | BStr -> Bool
bstrNull (BStr -> Bool) -> BStr -> Bool
forall a b. (a -> b) -> a -> b
$ BStr -> BStr
bstrTrimStart BStr
s -> [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [] ""
                  | Bool
otherwise -> do
                        case String -> Either String [Entry]
parseLine (String -> Either String [Entry])
-> String -> Either String [Entry]
forall a b. (a -> b) -> a -> b
$ ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ BStr -> String
bstrUnpack BStr
s of
                            Left y :: String
y -> m () -> ConduitT (a, BStr) (Target, Entry) m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitT (a, BStr) (Target, Entry) m ())
-> m () -> ConduitT (a, BStr) (Target, Entry) m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
warning (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y
                            -- only check Nothing as some items (e.g. "instance () :> Foo a")
                            -- don't roundtrip but do come out equivalent
                            Right [EDecl InfixDecl{}] -> () -> ConduitT (a, BStr) (Target, Entry) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- can ignore infix constructors
                            Right xs :: [Entry]
xs -> [Entry]
-> (Entry -> ConduitT (a, BStr) (Target, Entry) m ())
-> ConduitT (a, BStr) (Target, Entry) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Entry]
xs ((Entry -> ConduitT (a, BStr) (Target, Entry) m ())
 -> ConduitT (a, BStr) (Target, Entry) m ())
-> (Entry -> ConduitT (a, BStr) (Target, Entry) m ())
-> ConduitT (a, BStr) (Target, Entry) m ()
forall a b. (a -> b) -> a -> b
$ \x :: Entry
x ->
                                (Target, Entry) -> ConduitT (a, BStr) (Target, Entry) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (String
-> Maybe (String, String)
-> Maybe (String, String)
-> String
-> String
-> String
-> Target
Target String
url Maybe (String, String)
forall a. Maybe a
Nothing Maybe (String, String)
forall a. Maybe a
Nothing (Entry -> String
forall p. IsString p => Entry -> p
typeItem Entry
x) (Entry -> String
renderItem Entry
x) (String -> Target) -> String -> Target
forall a b. (a -> b) -> a -> b
$ [BStr] -> String
reformat ([BStr] -> String) -> [BStr] -> String
forall a b. (a -> b) -> a -> b
$ [BStr] -> [BStr]
forall a. [a] -> [a]
reverse [BStr]
com, Entry
x) -- descendBi stringShare x)
                        [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [] ""

typeItem :: Entry -> p
typeItem (EPackage x :: PkgName
x) = "package"
typeItem (EModule x :: PkgName
x) = "module"
typeItem _ = ""


-- FIXME: used to be in two different modules, now does and then undoes lots of stuff
reformat :: [BStr] -> String
reformat :: [BStr] -> String
reformat = [String] -> String
unlines ([String] -> String) -> ([BStr] -> [String]) -> [BStr] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BStr -> String) -> [BStr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BStr -> String
bstrUnpack


hierarchyC :: Monad m => URL -> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
hierarchyC :: String -> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
hierarchyC packageUrl :: String
packageUrl = ConduitT
  (Target, Entry)
  (Maybe Target, [Item])
  m
  (Maybe (String, String), Maybe (String, String))
-> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ConduitT
   (Target, Entry)
   (Maybe Target, [Item])
   m
   (Maybe (String, String), Maybe (String, String))
 -> ConduitM (Target, Entry) (Maybe Target, [Item]) m ())
-> ConduitT
     (Target, Entry)
     (Maybe Target, [Item])
     m
     (Maybe (String, String), Maybe (String, String))
-> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
forall a b. (a -> b) -> a -> b
$ ((Maybe (String, String), Maybe (String, String))
 -> (Target, Entry)
 -> ((Maybe (String, String), Maybe (String, String)),
     (Maybe Target, [Item])))
-> (Maybe (String, String), Maybe (String, String))
-> ConduitT
     (Target, Entry)
     (Maybe Target, [Item])
     m
     (Maybe (String, String), Maybe (String, String))
forall (m :: * -> *) t1 t2 b.
Monad m =>
(t1 -> t2 -> (t1, b)) -> t1 -> ConduitT t2 b m t1
mapAccumC (Maybe (String, String), Maybe (String, String))
-> (Target, Entry)
-> ((Maybe (String, String), Maybe (String, String)),
    (Maybe Target, [Item]))
f (Maybe (String, String)
forall a. Maybe a
Nothing, Maybe (String, String)
forall a. Maybe a
Nothing)
    where
        f :: (Maybe (String, String), Maybe (String, String))
-> (Target, Entry)
-> ((Maybe (String, String), Maybe (String, String)),
    (Maybe Target, [Item]))
f (pkg :: Maybe (String, String)
pkg, mod :: Maybe (String, String)
mod) (t :: Target
t, EPackage x :: PkgName
x) = (((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (PkgName -> String
strUnpack PkgName
x, String
url), Maybe (String, String)
forall a. Maybe a
Nothing), (Target -> Maybe Target
forall a. a -> Maybe a
Just Target
t{targetURL :: String
targetURL=String
url}, [PkgName -> Item
IPackage PkgName
x]))
            where url :: String
url = Target -> String
targetURL Target
t String -> ShowS
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
`orIfNull` String
packageUrl
        f (pkg :: Maybe (String, String)
pkg, mod :: Maybe (String, String)
mod) (t :: Target
t, EModule x :: PkgName
x) = ((Maybe (String, String)
pkg, (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (PkgName -> String
strUnpack PkgName
x, String
url)), (Target -> Maybe Target
forall a. a -> Maybe a
Just Target
t{targetPackage :: Maybe (String, String)
targetPackage=Maybe (String, String)
pkg, targetURL :: String
targetURL=String
url}, [PkgName -> Item
IModule PkgName
x]))
            where url :: String
url = Target -> String
targetURL Target
t String -> ShowS
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
`orIfNull` (if Bool
isGhc then PkgName -> String
ghcModuleURL PkgName
x else PkgName -> String
hackageModuleURL PkgName
x)
        f (pkg :: Maybe (String, String)
pkg, mod :: Maybe (String, String)
mod) (t :: Target
t, EDecl i :: Decl ()
i@InstDecl{}) = ((Maybe (String, String)
pkg, Maybe (String, String)
mod), (Maybe Target
forall a. Maybe a
Nothing, Decl () -> [Item]
forall a. Decl a -> [Item]
hseToItem_ Decl ()
i))
        f (pkg :: Maybe (String, String)
pkg, mod :: Maybe (String, String)
mod) (t :: Target
t, EDecl x :: Decl ()
x) = ((Maybe (String, String)
pkg, Maybe (String, String)
mod), (Target -> Maybe Target
forall a. a -> Maybe a
Just Target
t{targetPackage :: Maybe (String, String)
targetPackage=Maybe (String, String)
pkg, targetModule :: Maybe (String, String)
targetModule=Maybe (String, String)
mod, targetURL :: String
targetURL=String
url}, Decl () -> [Item]
forall a. Decl a -> [Item]
hseToItem_ Decl ()
x))
            where url :: String
url = Target -> String
targetURL Target
t String -> ShowS
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
`orIfNull` case Decl ()
x of
                            _ | [n :: String
n] <- Decl () -> [String]
forall a. Decl a -> [String]
declNames Decl ()
x -> Bool -> ShowS
hackageDeclURL (Decl () -> Bool
forall a. Decl a -> Bool
isTypeSig Decl ()
x) String
n
                              | Bool
otherwise -> ""

        isGhc :: Bool
isGhc = "~ghc" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
packageUrl Bool -> Bool -> Bool
|| "/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
packageUrl

        hseToItem_ :: Decl a -> [Item]
hseToItem_ x :: Decl a
x = Decl a -> [Item]
forall a. Decl a -> [Item]
hseToItem Decl a
x [Item] -> [Item] -> [Item]
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
`orIfNull` String -> [Item]
forall a. HasCallStack => String -> a
error ("hseToItem failed, " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Decl a -> String
forall a. Pretty a => a -> String
pretty Decl a
x)
        infix 1 `orIfNull`
        orIfNull :: t a -> t a -> t a
orIfNull x :: t a
x y :: t a
y = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x then t a
y else t a
x


renderPackage :: PkgName -> String
renderPackage x :: PkgName
x = "<b>package</b> <span class=name><s0>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML (PkgName -> String
strUnpack PkgName
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</s0></span>"
renderModule :: PkgName -> String
renderModule ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') (String -> (String, String))
-> (PkgName -> String) -> PkgName -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> String
strUnpack -> (pre :: String
pre,post :: String
post)) = "<b>module</b> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML String
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ "<span class=name><s0>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML String
post String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</s0></span>"


renderItem :: Entry -> String
renderItem :: Entry -> String
renderItem = ShowS
keyword ShowS -> (Entry -> String) -> Entry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> String
focus
    where
        keyword :: ShowS
keyword x :: String
x | Just b :: String
b <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "type family " String
x = "<b>type family</b> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
                  | (a :: String
a,b :: String
b) <- String -> (String, String)
word1 String
x, String
a String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
kws = "<b>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</b> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
                  | Bool
otherwise = String
x
            where kws :: [String]
kws = String -> [String]
words "class data type newtype"

        name :: ShowS
name x :: String
x = "<span class=name>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</span>" :: String

        focus :: Entry -> String
focus (EModule x :: PkgName
x) = PkgName -> String
renderModule PkgName
x
        focus (EPackage x :: PkgName
x) = PkgName -> String
renderPackage PkgName
x
        focus (EDecl x :: Decl ()
x) | [now :: String
now] <- Decl () -> [String]
forall a. Decl a -> [String]
declNames Decl ()
x, (pre :: String
pre,String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
now -> Just post :: String
post) <- String -> String -> (String, String)
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn String
now (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ Decl () -> String
forall a. Pretty a => a -> String
pretty Decl ()
x =
            if "(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
pre Bool -> Bool -> Bool
&& ")" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
post then
                ShowS
forall a. [a] -> [a]
init (ShowS
escapeHTML String
pre) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
name ("(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
highlight String
now String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")") String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML (ShowS
forall a. [a] -> [a]
tail String
post)
            else
                ShowS
escapeHTML String
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
name (ShowS
highlight String
now) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML String
post
        focus (EDecl x :: Decl ()
x) = Decl () -> String
forall a. Pretty a => a -> String
pretty Decl ()
x

        highlight :: String -> String
        highlight :: ShowS
highlight x :: String
x = "<s0>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</s0>"


parseLine :: String -> Either String [Entry]
parseLine :: String -> Either String [Entry]
parseLine x :: String
x@('@':str :: String
str) = case String
a of
        "package" | [b :: String
b] <- String -> [String]
words String
b, String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" -> [Entry] -> Either String [Entry]
forall a b. b -> Either a b
Right [PkgName -> Entry
EPackage (PkgName -> Entry) -> PkgName -> Entry
forall a b. (a -> b) -> a -> b
$ String -> PkgName
strPack String
b]
        "version" -> [Entry] -> Either String [Entry]
forall a b. b -> Either a b
Right []
        _ -> String -> Either String [Entry]
forall a b. a -> Either a b
Left (String -> Either String [Entry])
-> String -> Either String [Entry]
forall a b. (a -> b) -> a -> b
$ "unknown attribute: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    where (a :: String
a,b :: String
b) = String -> (String, String)
word1 String
str
parseLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "module " -> Just x :: String
x) = [Entry] -> Either String [Entry]
forall a b. b -> Either a b
Right [PkgName -> Entry
EModule (PkgName -> Entry) -> PkgName -> Entry
forall a b. (a -> b) -> a -> b
$ String -> PkgName
strPack String
x]
parseLine x :: String
x | Just x :: Decl ()
x <- String -> Maybe (Decl ())
readItem String
x = case Decl ()
x of
    TypeSig a :: ()
a bs :: [Name ()]
bs c :: Type ()
c -> [Entry] -> Either String [Entry]
forall a b. b -> Either a b
Right [Decl () -> Entry
EDecl (() -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig ()
a [Name ()
b] Type ()
c) | Name ()
b <- [Name ()]
bs]
    x :: Decl ()
x -> [Entry] -> Either String [Entry]
forall a b. b -> Either a b
Right [Decl () -> Entry
EDecl Decl ()
x]
parseLine x :: String
x = String -> Either String [Entry]
forall a b. a -> Either a b
Left (String -> Either String [Entry])
-> String -> Either String [Entry]
forall a b. (a -> b) -> a -> b
$ "failed to parse: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x


fixLine :: String -> String
fixLine :: ShowS
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "instance [incoherent] " -> Just x :: String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "instance [overlap ok] " -> Just x :: String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "instance [overlapping] " -> Just x :: String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "instance [safe] " -> Just x :: String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "(#) " -> Just x :: String
x) = "( # ) " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine ('[':x :: Char
x:xs :: String
xs) | Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("_(" :: String), (a :: String
a,']':b :: String
b) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ']') String
xs = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
fixLine ('[':':':xs :: String
xs) | (a :: String
a,']':b :: String
b) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ']') String
xs = "(:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
fixLine x :: String
x | "class " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> (String, String)
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn " where " String
x
fixLine x :: String
x = String
x


readItem :: String -> Maybe (Decl ())
readItem :: String -> Maybe (Decl ())
readItem x :: String
x | ParseOk y :: Decl ()
y <- String -> ParseResult (Decl ())
myParseDecl String
x = Decl () -> Maybe (Decl ())
forall a. a -> Maybe a
Just (Decl () -> Maybe (Decl ())) -> Decl () -> Maybe (Decl ())
forall a b. (a -> b) -> a -> b
$ Decl () -> Decl ()
forall l. Decl l -> Decl l
unGADT Decl ()
y
readItem x :: String
x -- newtype
    | Just x :: String
x <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "newtype " String
x
    , ParseOk (DataDecl an :: ()
an _ b :: Maybe (Context ())
b c :: DeclHead ()
c d :: [QualConDecl ()]
d e :: [Deriving ()]
e) <- (Decl () -> Decl ())
-> ParseResult (Decl ()) -> ParseResult (Decl ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decl () -> Decl ()
forall l. Decl l -> Decl l
unGADT (ParseResult (Decl ()) -> ParseResult (Decl ()))
-> ParseResult (Decl ()) -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ String -> ParseResult (Decl ())
myParseDecl (String -> ParseResult (Decl ()))
-> String -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ "data " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    = Decl () -> Maybe (Decl ())
forall a. a -> Maybe a
Just (Decl () -> Maybe (Decl ())) -> Decl () -> Maybe (Decl ())
forall a b. (a -> b) -> a -> b
$ ()
-> DataOrNew ()
-> Maybe (Context ())
-> DeclHead ()
-> [QualConDecl ()]
-> [Deriving ()]
-> Decl ()
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
DataDecl ()
an (() -> DataOrNew ()
forall l. l -> DataOrNew l
NewType ()) Maybe (Context ())
b DeclHead ()
c [QualConDecl ()]
d [Deriving ()]
e
readItem x :: String
x -- constructors
    | ParseOk (GDataDecl _ _ _ _ _ [GadtDecl s :: ()
s name :: Name ()
name _ _ _ ty :: Type ()
ty] _) <- String -> ParseResult (Decl ())
myParseDecl (String -> ParseResult (Decl ()))
-> String -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ "data Data where " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    , let f :: Type l -> Type l
f (TyBang _ _ _ (TyParen _ x :: Type l
x@TyApp{})) = Type l
x
          f (TyBang _ _ _ x :: Type l
x) = Type l
x
          f x :: Type l
x = Type l
x
    = Decl () -> Maybe (Decl ())
forall a. a -> Maybe a
Just (Decl () -> Maybe (Decl ())) -> Decl () -> Maybe (Decl ())
forall a b. (a -> b) -> a -> b
$ () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig ()
s [Name ()
name] (Type () -> Decl ()) -> Type () -> Decl ()
forall a b. (a -> b) -> a -> b
$ [Type ()] -> Type ()
forall a. [Type a] -> Type a
applyFun1 ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$ (Type () -> Type ()) -> [Type ()] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map Type () -> Type ()
forall l. Type l -> Type l
f ([Type ()] -> [Type ()]) -> [Type ()] -> [Type ()]
forall a b. (a -> b) -> a -> b
$ Type () -> [Type ()]
forall a. Type a -> [Type a]
unapplyFun Type ()
ty
readItem ('(':xs :: String
xs) -- tuple constructors
    | (com :: String
com,')':rest :: String
rest) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',') String
xs
    , ParseOk (TypeSig s :: ()
s [Ident{}] ty :: Type ()
ty) <- String -> ParseResult (Decl ())
myParseDecl (String -> ParseResult (Decl ()))
-> String -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
com Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) 'a' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest
    = Decl () -> Maybe (Decl ())
forall a. a -> Maybe a
Just (Decl () -> Maybe (Decl ())) -> Decl () -> Maybe (Decl ())
forall a b. (a -> b) -> a -> b
$ () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig ()
s [() -> String -> Name ()
forall l. l -> String -> Name l
Ident ()
s (String -> Name ()) -> String -> Name ()
forall a b. (a -> b) -> a -> b
$ '('Char -> ShowS
forall a. a -> [a] -> [a]
:String
comString -> ShowS
forall a. [a] -> [a] -> [a]
++")"] Type ()
ty
readItem (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "data (" -> Just xs :: String
xs)  -- tuple data type
    | (com :: String
com,')':rest :: String
rest) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',') String
xs
    , ParseOk (DataDecl a :: ()
a b :: DataOrNew ()
b c :: Maybe (Context ())
c d :: DeclHead ()
d e :: [QualConDecl ()]
e f :: [Deriving ()]
f) <- (Decl () -> Decl ())
-> ParseResult (Decl ()) -> ParseResult (Decl ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decl () -> Decl ()
forall l. Decl l -> Decl l
unGADT (ParseResult (Decl ()) -> ParseResult (Decl ()))
-> ParseResult (Decl ()) -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ String -> ParseResult (Decl ())
myParseDecl (String -> ParseResult (Decl ()))
-> String -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$
        "data " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
com Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) 'A' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest
    = Decl () -> Maybe (Decl ())
forall a. a -> Maybe a
Just (Decl () -> Maybe (Decl ())) -> Decl () -> Maybe (Decl ())
forall a b. (a -> b) -> a -> b
$ ()
-> DataOrNew ()
-> Maybe (Context ())
-> DeclHead ()
-> [QualConDecl ()]
-> [Deriving ()]
-> Decl ()
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
DataDecl ()
a DataOrNew ()
b Maybe (Context ())
c ((DeclHead () -> DeclHead ()) -> DeclHead () -> DeclHead ()
forall on. Uniplate on => (on -> on) -> on -> on
transform (String -> DeclHead () -> DeclHead ()
op (String -> DeclHead () -> DeclHead ())
-> String -> DeclHead () -> DeclHead ()
forall a b. (a -> b) -> a -> b
$ '('Char -> ShowS
forall a. a -> [a] -> [a]
:String
comString -> ShowS
forall a. [a] -> [a] -> [a]
++")") DeclHead ()
d) [QualConDecl ()]
e [Deriving ()]
f
    where op :: String -> DeclHead () -> DeclHead ()
op s :: String
s DHead{} = () -> Name () -> DeclHead ()
forall l. l -> Name l -> DeclHead l
DHead () (Name () -> DeclHead ()) -> Name () -> DeclHead ()
forall a b. (a -> b) -> a -> b
$ () -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
s
          op s :: String
s x :: DeclHead ()
x = DeclHead ()
x
readItem _ = Maybe (Decl ())
forall a. Maybe a
Nothing

myParseDecl :: String -> ParseResult (Decl ())
myParseDecl = (Decl SrcSpanInfo -> Decl ())
-> ParseResult (Decl SrcSpanInfo) -> ParseResult (Decl ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SrcSpanInfo -> ()) -> Decl SrcSpanInfo -> Decl ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SrcSpanInfo -> ()) -> Decl SrcSpanInfo -> Decl ())
-> (SrcSpanInfo -> ()) -> Decl SrcSpanInfo -> Decl ()
forall a b. (a -> b) -> a -> b
$ () -> SrcSpanInfo -> ()
forall a b. a -> b -> a
const ()) (ParseResult (Decl SrcSpanInfo) -> ParseResult (Decl ()))
-> (String -> ParseResult (Decl SrcSpanInfo))
-> String
-> ParseResult (Decl ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Decl SrcSpanInfo)
parseDeclWithMode ParseMode
parseMode -- partial application, to share the initialisation cost

unGADT :: Decl l -> Decl l
unGADT (GDataDecl a :: l
a b :: DataOrNew l
b c :: Maybe (Context l)
c d :: DeclHead l
d _  [] e :: [Deriving l]
e) = l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
DataDecl l
a DataOrNew l
b Maybe (Context l)
c DeclHead l
d [] [Deriving l]
e
unGADT x :: Decl l
x = Decl l
x

prettyItem :: Entry -> String
prettyItem :: Entry -> String
prettyItem (EPackage x :: PkgName
x) = "package " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName -> String
strUnpack PkgName
x
prettyItem (EModule x :: PkgName
x) = "module " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName -> String
strUnpack PkgName
x
prettyItem (EDecl x :: Decl ()
x) = Decl () -> String
forall a. Pretty a => a -> String
pretty Decl ()
x


input_haddock_test :: IO ()
input_haddock_test :: IO ()
input_haddock_test = String -> IO () -> IO ()
testing "Input.Haddock.parseLine" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let a :: String
a === :: String -> String -> IO ()
=== b :: String
b | ([Entry] -> [String])
-> Either String [Entry] -> Either String [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Entry -> String) -> [Entry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> String
prettyItem) (String -> Either String [Entry]
parseLine String
a) Either String [String] -> Either String [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Either String [String]
forall a b. b -> Either a b
Right [String
b] = Char -> IO ()
putChar '.'
                | Bool
otherwise = String -> IO ()
forall a. HasCallStack => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (String, String, Either String [Entry], Either String [String])
-> String
forall a. Show a => a -> String
show (String
a,String
b,String -> Either String [Entry]
parseLine String
a, ([Entry] -> [String])
-> Either String [Entry] -> Either String [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Entry -> String) -> [Entry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> String
prettyItem) (Either String [Entry] -> Either String [String])
-> Either String [Entry] -> Either String [String]
forall a b. (a -> b) -> a -> b
$ String -> Either String [Entry]
parseLine String
a)
    let test :: String -> IO ()
test a :: String
a = String
a String -> String -> IO ()
=== String
a
    String -> IO ()
test "type FilePath = [Char]"
    String -> IO ()
test "data Maybe a"
    String -> IO ()
test "Nothing :: Maybe a"
    String -> IO ()
test "Just :: a -> Maybe a"
    String -> IO ()
test "newtype Identity a"
    String -> IO ()
test "foo :: Int# -> b"
    String -> IO ()
test "(,,) :: a -> b -> c -> (a, b, c)"
    String -> IO ()
test "data (,,) a b"
    String -> IO ()
test "reverse :: [a] -> [a]"
    String -> IO ()
test "reverse :: [:a:] -> [:a:]"
    String -> IO ()
test "module Foo.Bar"
    String -> IO ()
test "data Char"
    "data Char :: *" String -> String -> IO ()
=== "data Char"
    "newtype ModuleName :: *" String -> String -> IO ()
=== "newtype ModuleName"
    "Progress :: !(Maybe String) -> {-# UNPACK #-} !Int -> !(Int -> Bool) -> Progress" String -> String -> IO ()
===
        "Progress :: Maybe String -> Int -> (Int -> Bool) -> Progress"
    -- Broken in the last HSE release, fixed in HSE HEAD
    -- test "quotRemInt# :: Int# -> Int# -> (# Int#, Int# #)"
    String -> IO ()
test "( # ) :: Int"
    String -> IO ()
test "pattern MyPattern :: ()"