diff options
author | Ćukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-15 19:31:15 +0200 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-08-21 18:22:30 +0100 |
commit | 3f31e24656d42bc6c50f441e055b7ecc4fdec8d0 (patch) | |
tree | 98c470cbd517d655997fe59fb164353687e31977 /haddock-api/src/Haddock/Backends/Xhtml | |
parent | 1680145961545a3f2c2e184c2a5a661fb748d5a1 (diff) |
Implement list syntax sugaring logic for specialized types.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs | 19 |
1 files changed, 16 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs index c10c7e6e..30501a13 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} module Haddock.Backends.Xhtml.Specialize @@ -11,6 +13,7 @@ module Haddock.Backends.Xhtml.Specialize import Haddock.Syb import GHC +import Name import Data.Data @@ -43,12 +46,22 @@ specializeTyVarBndrs bndrs typs = bname (KindedTyVar (L _ name) _) = name -sugar :: HsType name -> HsType name +sugar :: (NamedThing name, DataId name) => HsType name -> HsType name sugar = sugarTuples . sugarLists -sugarLists :: HsType name -> HsType name -sugarLists = id +sugarLists :: forall name. (NamedThing name, DataId name) + => HsType name -> HsType name +sugarLists = everywhere $ mkT (sugarListsStep :: HsType name -> HsType name) + + +sugarListsStep :: NamedThing name => HsType name -> HsType name +sugarListsStep (HsAppTy (L _ (HsTyVar name)) ltyp) + | isBuiltInSyntax name' && strName == "[]" = HsListTy ltyp + where + name' = getName name + strName = occNameString . nameOccName $ name' +sugarListsStep typ = typ sugarTuples :: HsType name -> HsType name |