{-# 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.Maybe
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
DataType
Constr
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 -> DataType
Entry -> Constr
(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 PkgName
name 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 String
"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 String -> m ()
warning String
url 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 Int
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 (\(Maybe Target, [Item])
x -> (Maybe Target, [Item]) -> ()
forall a. NFData a => a -> ()
rnf (Maybe Target, [Item])
x () -> (Maybe Target, [Item]) -> (Maybe Target, [Item])
`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 String -> m ()
warning = [BStr] -> String -> ConduitM (Int, BStr) (Target, Entry) m ()
forall a.
Show a =>
[BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [] String
""
    where
        f :: [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [BStr]
com 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
$ \(a
i,BStr
s) -> case () of
                ()
_ | Just BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix BStr
"-- | " BStr
s -> [BStr] -> String -> ConduitT (a, BStr) (Target, Entry) m ()
f [BStr -> BStr
ignoreMath BStr
s] String
url
                  | Just BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix BStr
"--" 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 BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix BStr
"@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 [] String
""
                  | 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 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
":" 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 (f :: * -> *) a. Applicative f => a -> f a
pure () -- can ignore infix constructors
                            Right [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
$ \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 [] String
""


-- See https://github.com/ndmitchell/hoogle/issues/353
-- for functions like `tail` which start <math>.
ignoreMath :: BStr -> BStr
ignoreMath :: BStr -> BStr
ignoreMath BStr
x | Just BStr
x <- BStr
"&lt;math&gt;" BStr -> BStr -> Maybe BStr
`bstrStripPrefix` BStr
x
             = BStr -> Maybe BStr -> BStr
forall a. a -> Maybe a -> a
fromMaybe BStr
x (Maybe BStr -> BStr) -> Maybe BStr -> BStr
forall a b. (a -> b) -> a -> b
$ BStr
". " BStr -> BStr -> Maybe BStr
`bstrStripPrefix` BStr
x
ignoreMath BStr
x = BStr
x


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


-- 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 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 (Maybe (String, String)
pkg, Maybe (String, String)
mod) (Target
t, EPackage 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 (Maybe (String, String)
pkg, Maybe (String, String)
mod) (Target
t, EModule 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 (Maybe (String, String)
pkg, Maybe (String, String)
mod) (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 (Maybe (String, String)
pkg, Maybe (String, String)
mod) (Target
t, EDecl 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
                            Decl ()
_ | [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 -> String
""

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

        hseToItem_ :: Decl a -> [Item]
hseToItem_ 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 (String
"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 t a
x 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 PkgName
x = String
"<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]
++ String
"</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
== Char
'.') (String -> (String, String))
-> (PkgName -> String) -> PkgName -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> String
strUnpack -> (String
pre,String
post)) = String
"<b>module</b> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML String
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<span class=name><s0>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML String
post String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</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 String
x | Just String
b <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"type family " String
x = String
"<b>type family</b> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
                  | (String
a,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 = String
"<b>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</b> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
                  | Bool
otherwise = String
x
            where kws :: [String]
kws = String -> [String]
words String
"class data type newtype"

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

        focus :: Entry -> String
focus (EModule PkgName
x) = PkgName -> String
renderModule PkgName
x
        focus (EPackage PkgName
x) = PkgName -> String
renderPackage PkgName
x
        focus (EDecl Decl ()
x) | [String
now] <- Decl () -> [String]
forall a. Decl a -> [String]
declNames Decl ()
x, (String
pre,String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
now -> Just 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 -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
pre Bool -> Bool -> Bool
&& String
")" 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
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
highlight String
now String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") 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 Decl ()
x) = Decl () -> String
forall a. Pretty a => a -> String
pretty Decl ()
x

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


parseLine :: String -> Either String [Entry]
parseLine :: String -> Either String [Entry]
parseLine x :: String
x@(Char
'@':String
str) = case String
a of
        String
"package" | [String
b] <- String -> [String]
words String
b, String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" -> [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]
        String
"version" -> [Entry] -> Either String [Entry]
forall a b. b -> Either a b
Right []
        String
_ -> 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
$ String
"unknown attribute: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    where (String
a,String
b) = String -> (String, String)
word1 String
str
parseLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"module " -> Just 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 String
x | Just Decl ()
x <- String -> Maybe (Decl ())
readItem String
x = case Decl ()
x of
    TypeSig ()
a [Name ()]
bs 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]
    Decl ()
x -> [Entry] -> Either String [Entry]
forall a b. b -> Either a b
Right [Decl () -> Entry
EDecl Decl ()
x]
parseLine 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
$ String
"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 String
"instance [incoherent] " -> Just String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"instance [overlap ok] " -> Just String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"instance [overlapping] " -> Just String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"instance [safe] " -> Just String
x) = ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"instance " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"(#) " -> Just String
x) = String
"( # ) " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
fixLine (Char
'[':Char
x: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
"_(" :: String), (String
a,Char
']':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
== Char
']') String
xs = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
fixLine (Char
'[':Char
':':String
xs) | (String
a,Char
']':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
== Char
']') String
xs = String
"(:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
fixLine String
x | String
"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 String
" where " String
x
fixLine String
x = String
x


readItem :: String -> Maybe (Decl ())
readItem :: String -> Maybe (Decl ())
readItem String
x | ParseOk 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 String
x -- newtype
    | Just String
x <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"newtype " String
x
    , ParseOk (DataDecl ()
an DataOrNew ()
_ Maybe (Context ())
b DeclHead ()
c [QualConDecl ()]
d [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
$ String
"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 String
x -- constructors
    | ParseOk (GDataDecl ()
_ DataOrNew ()
_ Maybe (Context ())
_ DeclHead ()
_ Maybe (Type ())
_ [GadtDecl ()
s Name ()
name Maybe [TyVarBind ()]
_ Maybe (Context ())
_ Maybe [FieldDecl ()]
_ Type ()
ty] [Deriving ()]
_) <- String -> ParseResult (Decl ())
myParseDecl (String -> ParseResult (Decl ()))
-> String -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ String
"data Data where " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    , let f :: Type l -> Type l
f (TyBang l
_ BangType l
_ Unpackedness l
_ (TyParen l
_ x :: Type l
x@TyApp{})) = Type l
x
          f (TyBang l
_ BangType l
_ Unpackedness l
_ Type l
x) = Type l
x
          f 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 (Char
'(':String
xs) -- tuple constructors
    | (String
com,Char
')':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
== Char
',') String
xs
    , ParseOk (TypeSig ()
s [Ident{}] 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
+ Int
2) Char
'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
'('Char -> ShowS
forall a. a -> [a] -> [a]
:String
comString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"] Type ()
ty
readItem (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"data (" -> Just String
xs)  -- tuple data type
    | (String
com,Char
')':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
== Char
',') String
xs
    , ParseOk (DataDecl ()
a DataOrNew ()
b Maybe (Context ())
c DeclHead ()
d [QualConDecl ()]
e [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
$
        String
"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
+ Int
2) Char
'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
'('Char -> ShowS
forall a. a -> [a] -> [a]
:String
comString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")") DeclHead ()
d) [QualConDecl ()]
e [Deriving ()]
f
    where op :: String -> DeclHead () -> DeclHead ()
op 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 String
s DeclHead ()
x = DeclHead ()
x
readItem String
_ = 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 l
a DataOrNew l
b Maybe (Context l)
c DeclHead l
d Maybe (Kind l)
_  [] [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 Decl l
x = Decl l
x

prettyItem :: Entry -> String
prettyItem :: Entry -> String
prettyItem (EPackage PkgName
x) = String
"package " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName -> String
strUnpack PkgName
x
prettyItem (EModule PkgName
x) = String
"module " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName -> String
strUnpack PkgName
x
prettyItem (EDecl 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 String
"Input.Haddock.parseLine" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let String
a === :: String -> String -> IO ()
=== 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 Char
'.'
                | 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 String
a = String
a String -> String -> IO ()
=== String
a
    String -> IO ()
test String
"type FilePath = [Char]"
    String -> IO ()
test String
"data Maybe a"
    String -> IO ()
test String
"Nothing :: Maybe a"
    String -> IO ()
test String
"Just :: a -> Maybe a"
    String -> IO ()
test String
"newtype Identity a"
    String -> IO ()
test String
"foo :: Int# -> b"
    String -> IO ()
test String
"(,,) :: a -> b -> c -> (a, b, c)"
    String -> IO ()
test String
"data (,,) a b"
    String -> IO ()
test String
"reverse :: [a] -> [a]"
    String -> IO ()
test String
"reverse :: [:a:] -> [:a:]"
    String -> IO ()
test String
"module Foo.Bar"
    String -> IO ()
test String
"data Char"
    String
"data Char :: *" String -> String -> IO ()
=== String
"data Char"
    String
"newtype ModuleName :: *" String -> String -> IO ()
=== String
"newtype ModuleName"
    String
"Progress :: !(Maybe String) -> {-# UNPACK #-} !Int -> !(Int -> Bool) -> Progress" String -> String -> IO ()
===
        String
"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 String
"( # ) :: Int"
    String -> IO ()
test String
"pattern MyPattern :: ()"