From a9ac8c35752798eaca584a8c3bd7e57db567286f Mon Sep 17 00:00:00 2001 From: Scott Sedgwick Date: Tue, 5 Feb 2019 10:11:00 +1100 Subject: [PATCH] Updated HPDF library to latest compiler Updated stack.yaml resolver to lts-13.6 Fixed Readme file name error in cabal file Fixed an error in Graphics.PDF.Draw where returned elements of a list were assumed to have a head, and this was not guaranteed Removed redundant imports Added top-level type signatures where they did not exist Added explicit ignores of parser elements that were skipped Tidied syntax of some simple parsers Fixed places where type inference caused warnings Fixed orphaned instances (by moving the data type declaration) Fixed places where names shadowed existing instances --- Graphics/PDF/Draw.hs | 8 +- Graphics/PDF/Fonts/AFMParser.hs | 187 ++++++++++++------------- Graphics/PDF/Fonts/Encoding.hs | 8 +- Graphics/PDF/Fonts/FontTypes.hs | 5 - Graphics/PDF/Fonts/StandardFont.hs | 16 ++- Graphics/PDF/Fonts/Type1.hs | 13 +- Graphics/PDF/LowLevel/Serializer.hs | 3 - Graphics/PDF/Pages.hs | 4 +- Graphics/PDF/Typesetting.hs | 2 - Graphics/PDF/Typesetting/Breaking.hs | 2 +- Graphics/PDF/Typesetting/Horizontal.hs | 2 - HPDF.cabal | 2 +- stack.yaml | 2 +- 13 files changed, 113 insertions(+), 141 deletions(-) diff --git a/Graphics/PDF/Draw.hs b/Graphics/PDF/Draw.hs index eff9001..a5402ca 100644 --- a/Graphics/PDF/Draw.hs +++ b/Graphics/PDF/Draw.hs @@ -252,9 +252,11 @@ pdfDictMember k (PDFDictionary d) = M.member k d -- | Get a new resource name supplyName :: Draw String supplyName = do - (x:xs) <- gets supplyNames - modifyStrict $ \s -> s {supplyNames = xs} - return x + xs <- gets supplyNames + modifyStrict $ \s -> s {supplyNames = tail xs} + if xs == [] + then return "" + else return (head xs) emptyDrawState :: Int -> DrawState emptyDrawState ref = diff --git a/Graphics/PDF/Fonts/AFMParser.hs b/Graphics/PDF/Fonts/AFMParser.hs index ff517f1..16e0a80 100644 --- a/Graphics/PDF/Fonts/AFMParser.hs +++ b/Graphics/PDF/Fonts/AFMParser.hs @@ -23,22 +23,15 @@ module Graphics.PDF.Fonts.AFMParser( ) where import Text.ParserCombinators.Parsec hiding(space) -import Text.ParserCombinators.Parsec.Prim -import Text.ParserCombinators.Parsec.Char hiding(space) import Text.Parsec(modifyState,getState) import Text.Parsec.Prim(parserZero) import Data.Char(toUpper) -import System.Environment -import Data.Maybe(isJust,fromJust,mapMaybe) -import qualified Data.IntMap as IM -import Data.List(intersperse) import qualified Data.Map.Strict as M import Graphics.PDF.Fonts.Font(emptyFontStructure) import Paths_HPDF import Graphics.PDF.LowLevel.Types import Graphics.PDF.Fonts.Encoding(PostscriptName) import Graphics.PDF.Fonts.FontTypes -import Control.Monad.State data Metric = Metric { charCode :: Int , metricWidth :: Int @@ -74,6 +67,7 @@ data AFMFont = AFMFont { metrics :: [Metric] type AFMParser = GenParser Char AFMFont +emptyAFM :: AFMFont emptyAFM = AFMFont { metrics = [] , underlinePosition = 0 , underlineThickness = 0 @@ -95,11 +89,11 @@ capitalize (h:t) = toUpper h : t line :: AFMParser () -line = do string "\r\n" <|> string "\n" +line = do _ <- string "\r\n" <|> string "\n" return () toEndOfLine :: AFMParser () -toEndOfLine = do many (noneOf "\r\n") +toEndOfLine = do _ <- many (noneOf "\r\n") line return () @@ -109,22 +103,21 @@ getString = do line return c -getSentence :: AFMParser String -getSentence = do - c <- many1 (alphaNum <|> oneOf " -+") - line - return c +-- getSentence :: AFMParser String +-- getSentence = do +-- c <- many1 (alphaNum <|> oneOf " -+") +-- line +-- return c -getName :: AFMParser String -getName = do - c <- alphaNum >> many (alphaNum <|> oneOf " -+") - line - return c +-- getName :: AFMParser String +-- getName = do +-- c <- alphaNum >> many (alphaNum <|> oneOf " -+") +-- line +-- return c getInt :: AFMParser Int -getInt = do c <- getString - return $ read c +getInt = read <$> getString getFloat :: AFMParser Double getFloat = do @@ -133,8 +126,7 @@ getFloat = do return $ read c getBool :: AFMParser Bool -getBool = do c <- getString - return $ read (capitalize c) +getBool = read . capitalize <$> getString data CharacterSet = ExtendedRoman | Special @@ -145,15 +137,12 @@ data Weight = Medium | Roman deriving(Eq,Read,Show) -getCharacterSet :: AFMParser CharacterSet -getCharacterSet = do c <- getString - return $ read c +-- getCharacterSet :: AFMParser CharacterSet +-- getCharacterSet = read <$> getString -getWeigth :: AFMParser Weight -getWeigth = do c <- getString - return $ read c - - +-- getWeigth :: AFMParser Weight +-- getWeigth = read <$> getString + array :: AFMParser [String] array = sepEndBy (many1 (oneOf "-+0123456789")) (many1 (oneOf " ")) @@ -184,40 +173,36 @@ data Elem = C Int deriving(Eq,Read,Show) metricElem :: AFMParser Elem -metricElem = do char 'C' +metricElem = do _ <- char 'C' spaces - c <- number - return $ C c + C <$> number <|> - do string "WX" + do _ <- string "WX" spaces - c <- number - return $ WX c + WX <$> number <|> - do char 'N' + do _ <- char 'N' spaces c <- many1 (alphaNum <|> char '.') return $ N c <|> - do char 'B' + do _ <- char 'B' spaces c <- array return . B . map read $ c <|> - do char 'L' + do _ <- char 'L' spaces - many1 letter + _ <- many1 letter spaces - many1 letter + _ <- many1 letter return L - - - -isEncoded :: Metric -> Bool -isEncoded (Metric c _ _ _) = c /= (-1) + +-- isEncoded :: Metric -> Bool +-- isEncoded (Metric c _ _ _) = c /= (-1) mkMetric :: [Elem] -> Metric -mkMetric l = foldr addElem (Metric (-1) 0 "" []) l +mkMetric = foldr addElem (Metric (-1) 0 "" []) where addElem (C c) m = m {charCode=c} addElem (WX c) m = m {metricWidth=c} @@ -234,7 +219,7 @@ charMetric = do kernPair :: AFMParser KX -kernPair = do string "KPX" +kernPair = do _ <- string "KPX" spaces namea <- many1 alphaNum spaces @@ -248,20 +233,20 @@ kernPair = do string "KPX" keyword :: String -> AFMParser () -> AFMParser () keyword s action = do - string s + _ <- string s spaces action return () -anyKeyWord :: AFMParser () -anyKeyWord = do - many1 alphaNum - spaces - toEndOfLine +-- anyKeyWord :: AFMParser () +-- anyKeyWord = do +-- _ <- many1 alphaNum +-- spaces +-- toEndOfLine header :: String -> AFMParser () header s = do - string s + _ <- string s toEndOfLine return () @@ -275,16 +260,16 @@ notHeader s = do toEndOfLine specific :: AFMParser () -specific = choice [ try $ keyword "FontName" (getString >>= \name -> modifyState $ \afm -> afm {type1BaseFont = name}) - , try $ keyword "UnderlinePosition" (getInt >>= \name -> modifyState $ \afm -> afm {underlinePosition = name}) - , try $ keyword "UnderlineThickness" (getInt >>= \name -> modifyState $ \afm -> afm {underlineThickness = name}) - , try $ keyword "EncodingScheme" (getEncoding >>= \name -> modifyState $ \afm -> afm {encodingScheme = name}) - , try $ keyword "CapHeight" (getInt >>= \name -> modifyState $ \afm -> afm {afmCapHeight = name}) - , try $ keyword "Ascender" (getInt >>= \name -> modifyState $ \afm -> afm {afmAscent = name}) - , try $ keyword "Descender" (getInt >>= \name -> modifyState $ \afm -> afm {afmDescent = name}) - , try $ keyword "ItalicAngle" (getFloat >>= \name -> modifyState $ \afm -> afm {afmItalic = name}) - , try $ keyword "IsFixedPitch" (getBool >>= \name -> modifyState $ \afm -> afm {afmFixedPitch = name}) - , try $ keyword "FontBBox" (getArray >>= \name -> modifyState $ \afm -> afm {afmBBox = name}) +specific = choice [ try $ keyword "FontName" (getString >>= \name' -> modifyState $ \afm' -> afm' {type1BaseFont = name'}) + , try $ keyword "UnderlinePosition" (getInt >>= \name' -> modifyState $ \afm' -> afm' {underlinePosition = name'}) + , try $ keyword "UnderlineThickness" (getInt >>= \name' -> modifyState $ \afm' -> afm' {underlineThickness = name'}) + , try $ keyword "EncodingScheme" (getEncoding >>= \name' -> modifyState $ \afm' -> afm' {encodingScheme = name'}) + , try $ keyword "CapHeight" (getInt >>= \name' -> modifyState $ \afm' -> afm' {afmCapHeight = name'}) + , try $ keyword "Ascender" (getInt >>= \name' -> modifyState $ \afm' -> afm' {afmAscent = name'}) + , try $ keyword "Descender" (getInt >>= \name' -> modifyState $ \afm' -> afm' {afmDescent = name'}) + , try $ keyword "ItalicAngle" (getFloat >>= \name' -> modifyState $ \afm' -> afm' {afmItalic = name'}) + , try $ keyword "IsFixedPitch" (getBool >>= \name' -> modifyState $ \afm' -> afm' {afmFixedPitch = name'}) + , try $ keyword "FontBBox" (getArray >>= \name' -> modifyState $ \afm' -> afm' {afmBBox = name'}) , try $ notHeader "StartCharMetrics" ] @@ -302,32 +287,32 @@ afm :: AFMParser AFMFont afm = do header "StartFontMetrics" - many1 specific + _ <- many1 specific header "StartCharMetrics" charMetrics <- many1 charMetric header "EndCharMetrics" kerns <- option Nothing getKernData - string "EndFontMetrics" + _ <- string "EndFontMetrics" - modifyState $ \afm -> afm { metrics = charMetrics - , kernData = kerns - } + modifyState $ \afm' -> afm' { metrics = charMetrics + , kernData = kerns + } - afm <- getState - let [xmin,ymin,xmax,ymax] = afmBBox afm - if afmAscent afm == 0 + afm' <- getState + let [_,ymin,_,ymax] = afmBBox afm' + if afmAscent afm' == 0 then - if afmCapHeight afm /= 0 + if afmCapHeight afm' /= 0 then - return $ afm { afmAscent = afmCapHeight afm - } + return $ afm' { afmAscent = afmCapHeight afm' + } else let h = floor (ymax - ymin) in - return $ afm { afmAscent = h - , afmDescent = 0 - } + return $ afm' { afmAscent = h + , afmDescent = 0 + } else - return $ afm + return $ afm' addMetric :: M.Map PostscriptName GlyphCode -> Metric -> FontStructure -> FontStructure addMetric nameToGlyph m fs = @@ -359,31 +344,31 @@ fontToStructure :: AFMFont -> M.Map PostscriptName Char -> Maybe (M.Map PostscriptName GlyphCode) -> FontStructure -fontToStructure afm encoding maybeMapNameToGlyph = - let h = (afmAscent afm - afmDescent afm) - fs = emptyFontStructure { descent = fromIntegral $ - (afmDescent afm) +fontToStructure afm' encoding' maybeMapNameToGlyph = + let h = (afmAscent afm' - afmDescent afm') + fs = emptyFontStructure { descent = fromIntegral $ - (afmDescent afm') , height = fromIntegral $ h - , ascent = fromIntegral $ afmAscent afm - , fontBBox = afmBBox afm - , italicAngle = afmItalic afm - , capHeight = fromIntegral $ afmCapHeight afm - , fixedPitch = afmFixedPitch afm + , ascent = fromIntegral $ afmAscent afm' + , fontBBox = afmBBox afm' + , italicAngle = afmItalic afm' + , capHeight = fromIntegral $ afmCapHeight afm' + , fixedPitch = afmFixedPitch afm' , serif = False - , symbolic = afmSymbolic afm + , symbolic = afmSymbolic afm' , script = False - , nonSymbolic = not (afmSymbolic afm) + , nonSymbolic = not (afmSymbolic afm') , italic = False , allCap = False , smallCap = False , forceBold = False - , baseFont = type1BaseFont afm + , baseFont = type1BaseFont afm' } addName m d | charCode m == -1 = d | otherwise = M.insert (name m) (fromIntegral $ charCode m) d - nameToGlyph = maybe (foldr addName M.empty (metrics afm)) id maybeMapNameToGlyph - fs1 = foldr (addMetric nameToGlyph) fs (metrics afm) + nameToGlyph = maybe (foldr addName M.empty (metrics afm')) id maybeMapNameToGlyph + fs1 = foldr (addMetric nameToGlyph) fs (metrics afm') addEncodingMapping (pname,glyphcode) d = - let unicodeM = M.lookup pname encoding + let unicodeM = M.lookup pname encoding' in case unicodeM of Nothing -> d @@ -391,7 +376,7 @@ fontToStructure afm encoding maybeMapNameToGlyph = mapping = foldr addEncodingMapping M.empty (M.toList nameToGlyph) fs2 = fs1 { encoding = mapping} in - case kernData afm of + case kernData afm' of Nothing -> fs2 Just k -> foldr (addKern nameToGlyph) fs2 k @@ -406,21 +391,21 @@ parseFont (Left s) = do r <- afmParseFromFile afm path case r of Left e -> error (show e) - Right r -> return $ Just r + Right r' -> return $ Just r' parseFont (Right path) = do r <- afmParseFromFile afm path case r of Left e -> error (show e) - Right r -> return $ Just r + Right r' -> return $ Just r' getFont :: Either String AFMFont -> M.Map PostscriptName Char -- ^ Glyph name to unicode -> Maybe (M.Map PostscriptName GlyphCode) -- ^ Glyph name to glyph code if not standard coding -> IO (Maybe FontStructure) -getFont (Left s) encoding nameToGlyph = do +getFont (Left s) encoding' nameToGlyph = do result <- parseFont (Left s) case result of Nothing -> return Nothing - Just r -> return (Just $ fontToStructure r encoding nameToGlyph) -getFont (Right result) encoding nameToGlyph = return . Just $ fontToStructure result encoding nameToGlyph + Just r -> return (Just $ fontToStructure r encoding' nameToGlyph) +getFont (Right result) encoding' nameToGlyph = return . Just $ fontToStructure result encoding' nameToGlyph diff --git a/Graphics/PDF/Fonts/Encoding.hs b/Graphics/PDF/Fonts/Encoding.hs index e54b68c..143ed7b 100644 --- a/Graphics/PDF/Fonts/Encoding.hs +++ b/Graphics/PDF/Fonts/Encoding.hs @@ -20,16 +20,12 @@ module Graphics.PDF.Fonts.Encoding( ) where import Graphics.PDF.LowLevel.Types -import Data.Char import qualified Data.Map.Strict as M -import Graphics.PDF.Fonts.Font import System.FilePath import Paths_HPDF import qualified Data.ByteString.Char8 as C import Data.Char(digitToInt) import Data.Maybe(mapMaybe) -import qualified Data.Text as T -import qualified Data.Text.IO as T type PostscriptName = String @@ -42,10 +38,10 @@ isLine c | not (C.null c) = C.head c /= '#' | otherwise = False from4Hexa :: C.ByteString -> Int -from4Hexa a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 16^x) [3,2,1,0]) +from4Hexa a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 16^x) ([3,2,1,0] :: [Integer])) from3Octal:: C.ByteString -> Int -from3Octal a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 8^x) [2,1,0]) +from3Octal a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 8^x) ([2,1,0] :: [Integer])) toData :: [C.ByteString] -> Maybe (PostscriptName,Char) diff --git a/Graphics/PDF/Fonts/FontTypes.hs b/Graphics/PDF/Fonts/FontTypes.hs index 07c8745..4bb5912 100644 --- a/Graphics/PDF/Fonts/FontTypes.hs +++ b/Graphics/PDF/Fonts/FontTypes.hs @@ -17,8 +17,6 @@ module Graphics.PDF.Fonts.FontTypes( , FontStructure(..) , GlyphPair(..) , FontData(..) - , StdFont(..) - , Type1Font(..) , mkFlags ) where @@ -73,11 +71,8 @@ mkFlags fs = bit (fixedPitch fs) 1 .|. bit True n = (1 `shiftL` (n-1)) bit False _ = 0 -data StdFont = StdFont FontStructure -data Type1Font = Type1Font FontStructure (PDFReference EmbeddedFont) - data FontData = Type1Data B.ByteString diff --git a/Graphics/PDF/Fonts/StandardFont.hs b/Graphics/PDF/Fonts/StandardFont.hs index ba770d2..c715c96 100644 --- a/Graphics/PDF/Fonts/StandardFont.hs +++ b/Graphics/PDF/Fonts/StandardFont.hs @@ -16,17 +16,16 @@ module Graphics.PDF.Fonts.StandardFont( IsFont , GlyphSize , FontName(..) - , StdFont + , StdFont(..) , mkStdFont ) where import Graphics.PDF.LowLevel.Types import Graphics.PDF.Resources -import Data.Char import qualified Data.Map.Strict as M import Graphics.PDF.Fonts.Font -import Graphics.PDF.Fonts.AFMParser(getFont,parseFont,AFMFont(..)) +import Graphics.PDF.Fonts.AFMParser(getFont) import System.FilePath import Graphics.PDF.Fonts.Encoding import Graphics.PDF.Fonts.FontTypes @@ -66,15 +65,18 @@ instance Show FontName where show ZapfDingbats = "ZapfDingbats" + +data StdFont = StdFont FontStructure + instance PdfResourceObject StdFont where toRsrc (StdFont f) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "Type",AnyPdfObject . PDFName $ "Font") , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1") , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f) - ] ++ encoding - where encoding | baseFont f == show Symbol = [] - | baseFont f == show ZapfDingbats = [] - | otherwise = [(PDFName "Encoding",AnyPdfObject . PDFName $ "MacRomanEncoding")] + ] ++ encoding' + where encoding' | baseFont f == show Symbol = [] + | baseFont f == show ZapfDingbats = [] + | otherwise = [(PDFName "Encoding",AnyPdfObject . PDFName $ "MacRomanEncoding")] instance IsFont StdFont where getDescent (StdFont fs) s = trueSize s $ descent fs diff --git a/Graphics/PDF/Fonts/Type1.hs b/Graphics/PDF/Fonts/Type1.hs index 7f095d1..892aea7 100644 --- a/Graphics/PDF/Fonts/Type1.hs +++ b/Graphics/PDF/Fonts/Type1.hs @@ -15,7 +15,7 @@ module Graphics.PDF.Fonts.Type1( IsFont , GlyphSize - , Type1Font + , Type1Font(..) , AFMData , Type1FontStructure(..) , getAfmData @@ -24,16 +24,15 @@ module Graphics.PDF.Fonts.Type1( import Graphics.PDF.LowLevel.Types import Graphics.PDF.Resources -import Data.Char import qualified Data.Map.Strict as M import Graphics.PDF.Fonts.Font -import Graphics.PDF.Fonts.AFMParser -import System.FilePath +-- import Graphics.PDF.Fonts.AFMParser import Graphics.PDF.Fonts.Encoding import Graphics.PDF.Fonts.FontTypes -import Graphics.PDF.Fonts.AFMParser (AFMFont, parseFont) -import Data.List -import Data.Function(on) +import Graphics.PDF.Fonts.AFMParser (AFMFont, getFont, parseFont) +import Data.List + +data Type1Font = Type1Font FontStructure (PDFReference EmbeddedFont) instance IsFont Type1Font where getDescent (Type1Font fs _) s = trueSize s $ descent fs diff --git a/Graphics/PDF/LowLevel/Serializer.hs b/Graphics/PDF/LowLevel/Serializer.hs index 488e135..eb97add 100644 --- a/Graphics/PDF/LowLevel/Serializer.hs +++ b/Graphics/PDF/LowLevel/Serializer.hs @@ -18,9 +18,6 @@ module Graphics.PDF.LowLevel.Serializer( SerializeValue(..) ) where - -import Data.Monoid - import Data.Word import qualified Data.ByteString.Lazy as B import qualified Data.Binary.Builder as BU diff --git a/Graphics/PDF/Pages.hs b/Graphics/PDF/Pages.hs index ee4b3bb..293836f 100644 --- a/Graphics/PDF/Pages.hs +++ b/Graphics/PDF/Pages.hs @@ -46,8 +46,8 @@ import Data.List(zip4) import Graphics.PDF.Fonts.Font import Graphics.PDF.Data.PDFTree(PDFTree,Key) import Control.Monad.Writer -import Data.Binary.Builder(Builder,fromLazyByteString,fromByteString) -import Graphics.PDF.Fonts.FontTypes(FontData(..),Type1Font(..)) +import Data.Binary.Builder(fromByteString) +import Graphics.PDF.Fonts.FontTypes(FontData(..)) import Graphics.PDF.Fonts.Type1 -- | Set page annotations diff --git a/Graphics/PDF/Typesetting.hs b/Graphics/PDF/Typesetting.hs index fed02f7..10ca2e3 100644 --- a/Graphics/PDF/Typesetting.hs +++ b/Graphics/PDF/Typesetting.hs @@ -110,8 +110,6 @@ import Graphics.PDF.Typesetting.Layout import Graphics.PDF.Typesetting.Box import Graphics.PDF.Typesetting.StandardStyle import Graphics.PDF.Typesetting.WritingSystem -import Data.List(unfoldr,intersperse) -import Data.Char(isSpace,isAlpha) import qualified Data.Text as T -- | Display a formatted text in a given bounding rectangle with a given default paragraph style, a given default text style. No clipping diff --git a/Graphics/PDF/Typesetting/Breaking.hs b/Graphics/PDF/Typesetting/Breaking.hs index 9af38cb..43d884e 100644 --- a/Graphics/PDF/Typesetting/Breaking.hs +++ b/Graphics/PDF/Typesetting/Breaking.hs @@ -635,7 +635,7 @@ ripText :: Style s -> BRState -> [SpecialChar] -- ^ Special meaning glyph -> [Letter s] -- ^ List of chars and char width taking into account kerning -ripText s settings [] = [] +ripText _ _ [] = [] ripText s settings (NormalChar ca:BreakingHyphen:NormalChar cb:l) = let PDFFont f fontSize = (textFont . textStyle $ s) ga = charGlyph f ca diff --git a/Graphics/PDF/Typesetting/Horizontal.hs b/Graphics/PDF/Typesetting/Horizontal.hs index 4fd2ec0..1a2c1dd 100644 --- a/Graphics/PDF/Typesetting/Horizontal.hs +++ b/Graphics/PDF/Typesetting/Horizontal.hs @@ -35,7 +35,6 @@ import Graphics.PDF.Typesetting.Box import Control.Monad.Writer(tell) import Control.Monad(when) import Graphics.PDF.LowLevel.Serializer -import Graphics.PDF.Fonts.Font(AnyFont) -- | Current word (created from letter) is converted to a PDFString saveCurrentword :: PDFGlyph -> PDFGlyph @@ -328,7 +327,6 @@ instance (Style s) => DisplayableBox (HBox s) where let de = boxDescent a he = boxHeight a y' = y - he + de - theFont = styleFont style -- In word mode we have to apply a special function to the word -- otherwise we apply a different function to the sentence if (isJust . wordStyle $ style) diff --git a/HPDF.cabal b/HPDF.cabal index 752fe9c..5f54cf2 100644 --- a/HPDF.cabal +++ b/HPDF.cabal @@ -17,7 +17,7 @@ extra-source-files: Test/Makefile Test/Penrose.hs Test/test.hs - README.txt + README.md NEWS.txt TODO.txt changelog diff --git a/stack.yaml b/stack.yaml index 655499c..f9d03ad 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,7 @@ # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-6.14 +resolver: lts-13.6 # Local packages, usually specified by relative directory name packages: