{-# 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
import Safe


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


fakePackage :: PkgName -> String -> (Maybe Target, [Item])
fakePackage :: PkgName -> [Char] -> (Maybe Target, [Item])
fakePackage PkgName
name [Char]
desc = (Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ [Char]
-> Maybe ([Char], [Char])
-> Maybe ([Char], [Char])
-> [Char]
-> [Char]
-> [Char]
-> Target
Target (PkgName -> [Char]
hackagePackageURL PkgName
name) Maybe ([Char], [Char])
forall a. Maybe a
Nothing Maybe ([Char], [Char])
forall a. Maybe a
Nothing [Char]
"package" (PkgName -> [Char]
renderPackage PkgName
name) [Char]
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 :: forall (m :: * -> *) i.
Monad m =>
([Char] -> m ())
-> [Char] -> LBStr -> ConduitM i (Maybe Target, [Item]) m ()
parseHoogle [Char] -> m ()
warning [Char]
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 ()
-> ConduitT BStr (Maybe Target, [Item]) m ()
-> ConduitT i (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM BStr BStr m ()
forall (m :: * -> *). Monad m => ConduitM BStr BStr m ()
linesCR ConduitM BStr BStr m ()
-> ConduitT BStr (Maybe Target, [Item]) m ()
-> ConduitT BStr (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT 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 ()
-> ConduitT (Int, BStr) (Maybe Target, [Item]) m ()
-> ConduitT BStr (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ([Char] -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
forall (m :: * -> *).
Monad m =>
([Char] -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
parserC [Char] -> m ()
warning ConduitM (Int, BStr) (Target, Entry) m ()
-> ConduitT (Target, Entry) (Maybe Target, [Item]) m ()
-> ConduitT (Int, BStr) (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| [Char] -> ConduitT (Target, Entry) (Maybe Target, [Item]) m ()
forall (m :: * -> *).
Monad m =>
[Char] -> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()
hierarchyC [Char]
url ConduitT (Target, Entry) (Maybe Target, [Item]) m ()
-> ConduitT (Maybe Target, [Item]) (Maybe Target, [Item]) m ()
-> ConduitT (Target, Entry) (Maybe Target, [Item]) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ((Maybe Target, [Item]) -> (Maybe Target, [Item]))
-> ConduitT (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])
forall a b. a -> b -> b
`seq` (Maybe Target, [Item])
x)

parserC :: Monad m => (String -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
parserC :: forall (m :: * -> *).
Monad m =>
([Char] -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()
parserC [Char] -> m ()
warning = [BStr] -> [Char] -> ConduitT (Int, BStr) (Target, Entry) m ()
forall {a}.
Show a =>
[BStr] -> [Char] -> ConduitT (a, BStr) (Target, Entry) m ()
f [] [Char]
""
    where
        f :: [BStr] -> [Char] -> ConduitT (a, BStr) (Target, Entry) m ()
f [BStr]
com [Char]
url = do
            Maybe (a, BStr)
x <- ConduitT (a, BStr) (Target, Entry) m (Maybe (a, BStr))
forall (m :: * -> *) i o. Monad m => ConduitT i o 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] -> [Char] -> ConduitT (a, BStr) (Target, Entry) m ()
f [BStr -> BStr
ignoreMath BStr
s] [Char]
url
                  | Just BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix BStr
"--" BStr
s -> [BStr] -> [Char] -> ConduitT (a, BStr) (Target, Entry) m ()
f (if [BStr] -> Bool
forall a. [a] -> 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) [Char]
url
                  | Just BStr
s <- BStr -> BStr -> Maybe BStr
bstrStripPrefix BStr
"@url " BStr
s -> [BStr] -> [Char] -> ConduitT (a, BStr) (Target, Entry) m ()
f [BStr]
com (BStr -> [Char]
bstrUnpack BStr
s)
                  | BStr -> Bool
bstrNull (BStr -> Bool) -> BStr -> Bool
forall a b. (a -> b) -> a -> b
$ BStr -> BStr
bstrTrimStart BStr
s -> [BStr] -> [Char] -> ConduitT (a, BStr) (Target, Entry) m ()
f [] [Char]
""
                  | Bool
otherwise -> do
                        case [Char] -> Either [Char] [Entry]
parseLine ([Char] -> Either [Char] [Entry])
-> [Char] -> Either [Char] [Entry]
forall a b. (a -> b) -> a -> b
$ ShowS
fixLine ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ BStr -> [Char]
bstrUnpack BStr
s of
                            Left [Char]
y -> m () -> ConduitT (a, BStr) (Target, Entry) m ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT (a, BStr) (Target, Entry) m a
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
$ [Char] -> m ()
warning ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show a
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
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 a. a -> ConduitT (a, BStr) (Target, Entry) m a
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 ([Char]
-> Maybe ([Char], [Char])
-> Maybe ([Char], [Char])
-> [Char]
-> [Char]
-> [Char]
-> Target
Target [Char]
url Maybe ([Char], [Char])
forall a. Maybe a
Nothing Maybe ([Char], [Char])
forall a. Maybe a
Nothing (Entry -> [Char]
forall {a}. IsString a => Entry -> a
typeItem Entry
x) (Entry -> [Char]
renderItem Entry
x) ([Char] -> Target) -> [Char] -> Target
forall a b. (a -> b) -> a -> b
$ [BStr] -> [Char]
reformat ([BStr] -> [Char]) -> [BStr] -> [Char]
forall a b. (a -> b) -> a -> b
$ [BStr] -> [BStr]
forall a. [a] -> [a]
reverse [BStr]
com, Entry
x) -- descendBi stringShare x)
                        [BStr] -> [Char] -> ConduitT (a, BStr) (Target, Entry) m ()
f [] [Char]
""


-- 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 -> a
typeItem (EPackage PkgName
x) = a
"package"
typeItem (EModule PkgName
x) = a
"module"
typeItem Entry
_ = a
""


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


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

        isGhc :: Bool
isGhc = [Char]
"~ghc" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
packageUrl Bool -> Bool -> Bool
|| [Char]
"/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
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` [Char] -> [Item]
forall a. HasCallStack => [Char] -> a
error ([Char]
"hseToItem failed, " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Decl a -> [Char]
forall a. Pretty a => a -> [Char]
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 a. 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 -> [Char]
renderPackage PkgName
x = [Char]
"<b>package</b> <span class=name><s0>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML (PkgName -> [Char]
strUnpack PkgName
x) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</s0></span>"
renderModule :: PkgName -> [Char]
renderModule ((Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') ([Char] -> ([Char], [Char]))
-> (PkgName -> [Char]) -> PkgName -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> [Char]
strUnpack -> ([Char]
pre,[Char]
post)) = [Char]
"<b>module</b> " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML [Char]
pre [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"<span class=name><s0>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeHTML [Char]
post [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</s0></span>"


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

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

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

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


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


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


readItem :: String -> Maybe (Decl ())
readItem :: [Char] -> Maybe (Decl ())
readItem [Char]
x | ParseOk Decl ()
y <- [Char] -> ParseResult (Decl ())
myParseDecl [Char]
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 [Char]
x -- newtype
    | Just [Char]
x <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"newtype " [Char]
x
    , ParseOk (DataDecl ()
an DataOrNew ()
_ Maybe (Context ())
b DeclHead ()
c [QualConDecl ()]
d [Deriving ()]
e) <- (Decl () -> Decl ())
-> ParseResult (Decl ()) -> ParseResult (Decl ())
forall a b. (a -> b) -> ParseResult a -> ParseResult b
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
$ [Char] -> ParseResult (Decl ())
myParseDecl ([Char] -> ParseResult (Decl ()))
-> [Char] -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ [Char]
"data " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
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 [Char]
x -- constructors
    | ParseOk (GDataDecl ()
_ DataOrNew ()
_ Maybe (Context ())
_ DeclHead ()
_ Maybe (Type ())
_ [GadtDecl ()
s Name ()
name Maybe [TyVarBind ()]
_ Maybe (Context ())
_ Maybe [FieldDecl ()]
_ Type ()
ty] [Deriving ()]
_) <- [Char] -> ParseResult (Decl ())
myParseDecl ([Char] -> ParseResult (Decl ()))
-> [Char] -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ [Char]
"data Data where " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
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
'(':[Char]
xs) -- tuple constructors
    | ([Char]
com,Char
')':[Char]
rest) <- (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') [Char]
xs
    , ParseOk (TypeSig ()
s [Ident{}] Type ()
ty) <- [Char] -> ParseResult (Decl ())
myParseDecl ([Char] -> ParseResult (Decl ()))
-> [Char] -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
com Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'a' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
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 [() -> [Char] -> Name ()
forall l. l -> [Char] -> Name l
Ident ()
s ([Char] -> Name ()) -> [Char] -> Name ()
forall a b. (a -> b) -> a -> b
$ Char
'('Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
com[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"] Type ()
ty
readItem ([Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"data (" -> Just [Char]
xs)  -- tuple data type
    | ([Char]
com,Char
')':[Char]
rest) <- (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') [Char]
xs
    , ParseOk (DataDecl ()
a DataOrNew ()
b Maybe (Context ())
c DeclHead ()
d [QualConDecl ()]
e [Deriving ()]
f) <- (Decl () -> Decl ())
-> ParseResult (Decl ()) -> ParseResult (Decl ())
forall a b. (a -> b) -> ParseResult a -> ParseResult b
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
$ [Char] -> ParseResult (Decl ())
myParseDecl ([Char] -> ParseResult (Decl ()))
-> [Char] -> ParseResult (Decl ())
forall a b. (a -> b) -> a -> b
$
        [Char]
"data " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
com Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'A' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
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 ([Char] -> DeclHead () -> DeclHead ()
op ([Char] -> DeclHead () -> DeclHead ())
-> [Char] -> DeclHead () -> DeclHead ()
forall a b. (a -> b) -> a -> b
$ Char
'('Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
com[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")") DeclHead ()
d) [QualConDecl ()]
e [Deriving ()]
f
    where op :: [Char] -> DeclHead () -> DeclHead ()
op [Char]
s DHead{} = () -> Name () -> DeclHead ()
forall l. l -> Name l -> DeclHead l
DHead () (Name () -> DeclHead ()) -> Name () -> DeclHead ()
forall a b. (a -> b) -> a -> b
$ () -> [Char] -> Name ()
forall l. l -> [Char] -> Name l
Ident () [Char]
s
          op [Char]
s DeclHead ()
x = DeclHead ()
x
readItem [Char]
_ = Maybe (Decl ())
forall a. Maybe a
Nothing

myParseDecl :: [Char] -> ParseResult (Decl ())
myParseDecl = (Decl SrcSpanInfo -> Decl ())
-> ParseResult (Decl SrcSpanInfo) -> ParseResult (Decl ())
forall a b. (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SrcSpanInfo -> ()) -> Decl SrcSpanInfo -> Decl ()
forall a b. (a -> b) -> Decl a -> Decl b
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 ()))
-> ([Char] -> ParseResult (Decl SrcSpanInfo))
-> [Char]
-> ParseResult (Decl ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> [Char] -> 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 -> [Char]
prettyItem (EPackage PkgName
x) = [Char]
"package " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName -> [Char]
strUnpack PkgName
x
prettyItem (EModule PkgName
x) = [Char]
"module " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName -> [Char]
strUnpack PkgName
x
prettyItem (EDecl Decl ()
x) = Decl () -> [Char]
forall a. Pretty a => a -> [Char]
pretty Decl ()
x


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