mirror of
https://github.com/phadej/hooglite.git
synced 2024-11-22 11:23:09 +03:00
commit
2d15d59ee6
28
.github/workflows/haskell-ci.yml
vendored
28
.github/workflows/haskell-ci.yml
vendored
@ -8,9 +8,9 @@
|
||||
#
|
||||
# For more information, see https://github.com/haskell-CI/haskell-ci
|
||||
#
|
||||
# version: 0.15.20230128
|
||||
# version: 0.19.20240402
|
||||
#
|
||||
# REGENDATA ("0.15.20230128",["github","cabal.project"])
|
||||
# REGENDATA ("0.19.20240402",["github","cabal.project"])
|
||||
#
|
||||
name: Haskell-CI
|
||||
on:
|
||||
@ -32,9 +32,9 @@ jobs:
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
- compiler: ghc-9.2.5
|
||||
- compiler: ghc-9.8.2
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.2.5
|
||||
compilerVersion: 9.8.2
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
fail-fast: false
|
||||
@ -44,11 +44,11 @@ jobs:
|
||||
apt-get update
|
||||
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
|
||||
mkdir -p "$HOME/.ghcup/bin"
|
||||
curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup"
|
||||
curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
|
||||
chmod a+x "$HOME/.ghcup/bin/ghcup"
|
||||
"$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml;
|
||||
"$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml;
|
||||
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
|
||||
"$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
|
||||
"$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
|
||||
env:
|
||||
HCKIND: ${{ matrix.compilerKind }}
|
||||
HCNAME: ${{ matrix.compiler }}
|
||||
@ -60,11 +60,13 @@ jobs:
|
||||
echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
|
||||
echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
|
||||
HCDIR=/opt/$HCKIND/$HCVER
|
||||
HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
|
||||
HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
|
||||
HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
|
||||
HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
|
||||
echo "HC=$HC" >> "$GITHUB_ENV"
|
||||
echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
|
||||
echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
|
||||
echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV"
|
||||
echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
|
||||
echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
|
||||
echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
|
||||
HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
|
||||
echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
|
||||
echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
|
||||
@ -114,8 +116,8 @@ jobs:
|
||||
- name: install cabal-plan
|
||||
run: |
|
||||
mkdir -p $HOME/.cabal/bin
|
||||
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
|
||||
echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
|
||||
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
|
||||
echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
|
||||
xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
|
||||
rm -f cabal-plan.xz
|
||||
chmod a+x $HOME/.cabal/bin/cabal-plan
|
||||
|
@ -1,4 +1,4 @@
|
||||
with-compiler: ghc-9.2.5
|
||||
with-compiler: ghc-9.8.2
|
||||
packages: .
|
||||
|
||||
constraints: ghc-lib-parser-ex -no-ghc-lib -auto
|
||||
|
@ -1,6 +1,6 @@
|
||||
cabal-version: 2.4
|
||||
name: hooglite
|
||||
version: 0.20230131
|
||||
version: 0.20240409
|
||||
license: BSD-3-Clause
|
||||
license-file: LICENSE
|
||||
category: Development
|
||||
@ -12,7 +12,7 @@ description:
|
||||
author: Oleg Grenrus <oleg.grenrus@iki.fi>
|
||||
maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
|
||||
build-type: Simple
|
||||
tested-with: GHC ==9.2.5
|
||||
tested-with: GHC ==9.8.2
|
||||
extra-source-files: test-data/*.txt
|
||||
|
||||
source-repository head
|
||||
@ -26,22 +26,22 @@ library
|
||||
|
||||
-- GHC-boot libraries
|
||||
build-depends:
|
||||
, base ^>=4.16.3.0
|
||||
, bytestring ^>=0.11.3.1
|
||||
, base ^>=4.19.0.0
|
||||
, bytestring ^>=0.12.0.1
|
||||
, containers ^>=0.6.5.1
|
||||
, pretty ^>=1.1.3.6
|
||||
|
||||
-- Cabal is special
|
||||
build-depends: Cabal ^>=3.8.1.0
|
||||
build-depends: Cabal ^>=3.10.3.0
|
||||
|
||||
-- rest of the dependencies
|
||||
build-depends:
|
||||
, bifunctors ^>=5.5.11
|
||||
, bifunctors ^>=5.6.2
|
||||
, edit-distance ^>=0.2.2.1
|
||||
, fin ^>=0.2.1
|
||||
, ghc-lib-parser ^>=9.4.4.20221225
|
||||
, ghc-lib-parser-ex ^>=9.4.0.0
|
||||
, mtl ^>=2.2.2
|
||||
, fin ^>=0.3
|
||||
, ghc-lib-parser ^>=9.8.2.20240223
|
||||
, ghc-lib-parser-ex ^>=9.8.0.2
|
||||
, mtl ^>=2.3.1
|
||||
, text-short ^>=0.1.5
|
||||
, unification-fd ^>=0.11.1
|
||||
|
||||
@ -100,6 +100,6 @@ test-suite hooglite-tests
|
||||
, mtl
|
||||
|
||||
build-depends:
|
||||
, tasty ^>=1.4.2.1
|
||||
, tasty ^>=1.5
|
||||
, tasty-golden ^>=2.3.4
|
||||
, tasty-hunit ^>=0.10.0.3
|
||||
|
@ -2,13 +2,14 @@
|
||||
module Hooglite.Declaration where
|
||||
|
||||
import Control.Monad (join)
|
||||
import Data.Foldable (toList)
|
||||
import GHC.Hs.Extension (GhcPs)
|
||||
import GHC.Types.SrcLoc (GenLocated (L))
|
||||
|
||||
import qualified GHC.Hs.Binds as GHC
|
||||
import qualified GHC.Hs.Decls as GHC
|
||||
import qualified GHC.Hs.Type as GHC
|
||||
import qualified GHC.Types.SrcLoc as GHC
|
||||
import qualified GHC.Hs.Binds as GHC
|
||||
import qualified GHC.Hs.Decls as GHC
|
||||
import qualified GHC.Hs.Type as GHC
|
||||
import qualified GHC.Types.SrcLoc as GHC
|
||||
|
||||
import Hooglite.GHC.Utils
|
||||
import Hooglite.MonoPoly.Name
|
||||
@ -65,8 +66,8 @@ sigToDeclaration sig _ = Left $ "sigToDeclaration " ++ showAstData sig
|
||||
|
||||
conToDeclaration :: GHC.ConDecl GhcPs -> (Name -> Declaration -> r) -> Either String [r]
|
||||
conToDeclaration d@GHC.ConDeclGADT { GHC.con_names = names, GHC.con_g_args = details, GHC.con_res_ty = ty } mk = Right
|
||||
[ mk (toName name) $ ConD (fmap genType $ join $ apps_ <$> convType ty <*> details') (fakeShowPpr (d { GHC.con_names = [L l name] } ))
|
||||
| L l name <- names
|
||||
[ mk (toName name) $ ConD (fmap genType $ join $ apps_ <$> convType ty <*> details') (fakeShowPpr (d { GHC.con_names = pure (L l name) } ))
|
||||
| L l name <- toList names
|
||||
]
|
||||
where
|
||||
details' :: Maybe [Ty]
|
||||
@ -80,4 +81,4 @@ extractConDeclGADTDetailsTyVars ::
|
||||
GHC.HsConDeclGADTDetails GhcPs -> [GHC.LHsType GhcPs]
|
||||
extractConDeclGADTDetailsTyVars con_args = case con_args of
|
||||
GHC.PrefixConGADT args -> map GHC.hsScaledThing args
|
||||
GHC.RecConGADT (L _ flds) _ -> map (GHC.cd_fld_type . GHC.unLoc) $ flds
|
||||
GHC.RecConGADT (L _ flds) _ -> map (GHC.cd_fld_type . GHC.unLoc) $ flds
|
||||
|
@ -2,14 +2,14 @@ module Hooglite.GHC.Utils where
|
||||
|
||||
import Data.Data (Data)
|
||||
import Data.List (foldl')
|
||||
import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt_set)
|
||||
import GHC.Parser.Lexer (ParseResult (..), PState (errors))
|
||||
import GHC.Utils.Outputable (Outputable)
|
||||
import GHC.Types.Error (getMessages)
|
||||
import GHC.Utils.Error (pprMsgEnvelopeBagWithLoc)
|
||||
import GHC.Driver.Ppr (showPpr)
|
||||
import GHC.Driver.Session (DynFlags, defaultDynFlags, xopt_set)
|
||||
import GHC.Parser.Lexer (PState (errors), ParseResult (..))
|
||||
import GHC.Types.Error (NoDiagnosticOpts (..), getMessages)
|
||||
import GHC.Utils.Error (pprMsgEnvelopeBagWithLoc)
|
||||
import GHC.Utils.Outputable (Outputable)
|
||||
|
||||
import Language.Haskell.GhclibParserEx.GHC.Settings.Config (fakeLlvmConfig, fakeSettings)
|
||||
import Language.Haskell.GhclibParserEx.GHC.Settings.Config (fakeSettings)
|
||||
|
||||
import qualified GHC.Hs.Dump
|
||||
import qualified GHC.LanguageExtensions.Type as LangExt
|
||||
@ -19,7 +19,7 @@ import qualified GHC.LanguageExtensions.Type as LangExt
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
fakeDynFlags :: DynFlags
|
||||
fakeDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig
|
||||
fakeDynFlags = defaultDynFlags fakeSettings
|
||||
|
||||
fakeShowPpr :: Outputable a => a -> String
|
||||
fakeShowPpr = showPpr fakeDynFlags
|
||||
@ -62,4 +62,4 @@ parse p s = case p s dynFlags of
|
||||
POk _ x -> Right x
|
||||
PFailed pstate -> do
|
||||
let es = errors pstate
|
||||
Left $ map fakeShowPpr $ pprMsgEnvelopeBagWithLoc $ getMessages es
|
||||
Left $ map fakeShowPpr $ pprMsgEnvelopeBagWithLoc NoDiagnosticOpts $ getMessages es
|
||||
|
@ -23,6 +23,7 @@ import GHC.Hs.Decls (HsDataDefn (..), HsDecl (..), TyClDecl (..))
|
||||
import GHC.Types.SrcLoc (GenLocated (L))
|
||||
|
||||
import Language.Haskell.GhclibParserEx.GHC.Parser (parseDeclaration)
|
||||
import Language.Haskell.Syntax.Decls (DataDefnCons (..))
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
@ -121,7 +122,7 @@ parseItem str = first unlines $
|
||||
first singleton $ toDeclaration decl LDecl
|
||||
|
||||
parseConstructor
|
||||
| Right (L _ (TyClD _ (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = [L _ d]}}))) <- parse parseDeclaration $ "data Data where " ++ str
|
||||
| Right (L _ (TyClD _ (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = DataTypeCons False [L _ d]}}))) <- parse parseDeclaration $ "data Data where " ++ str
|
||||
= first singleton $ conToDeclaration d LDecl
|
||||
|
||||
| otherwise
|
||||
|
@ -52,7 +52,7 @@ convType = go where
|
||||
go (L _ (GHC.HsParTy _ a)) = go a
|
||||
go (L _ (GHC.HsFunTy _ _ a b)) = join $ arr_ <$> go a <*> go b
|
||||
go (L _ (GHC.HsAppTy _ a b)) = join $ app_ <$> go a <*> go b
|
||||
go (L _ (GHC.HsAppKindTy _ a b)) = join $ app_ <$> go a <*> go b
|
||||
go (L _ (GHC.HsAppKindTy _ a _ b)) = join $ app_ <$> go a <*> go b
|
||||
go (L _ (GHC.HsStarTy _ _)) = Just "*"
|
||||
go (L _ (GHC.HsKindSig _ a _)) = go a
|
||||
go (L _ (GHC.HsTyVar _ _ (L _ n))) = Just (Mono (Free (toName n)))
|
||||
|
Loading…
Reference in New Issue
Block a user