Skip to content

Commit

Permalink
upgrade(ghc): changes necessary for ghc 8.10 and 9.0 compatibility (d…
Browse files Browse the repository at this point in the history
…ocopt#44)

* cabal: set default-language, silence warning
* stack: bump to lts-18.10 (ghc 8.10.7)
* stack: don't require nix by default
* fix warnings, drop th-lift, require ghc 8.0+
* allow template-haskell 2.17.0.0, build with stackage nightly (ghc 9.0.1)
* bump version to 0.7.0.7, draft changelog
* don't bother version-controlling stack.yaml.lock
  • Loading branch information
simonmichael authored Sep 22, 2021
1 parent 4ad777b commit bdc4c67
Show file tree
Hide file tree
Showing 8 changed files with 34 additions and 45 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -21,3 +21,4 @@ cabal.sandbox.config
# extra
tmp
.stack-work
stack.yaml.lock
4 changes: 4 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
### 0.7.0.7 (unreleased)

- update bounds, fix warnings, require ghc 8.0+

### 0.7.0.6

- Fixes issue causing compilation error to happen with ghc-8.8.2 [#33][#34]
Expand Down
22 changes: 9 additions & 13 deletions System/Console/Docopt/QQ/Instances.hs
Original file line number Diff line number Diff line change
@@ -1,19 +1,15 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveLift#-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK hide, prune #-}

module System.Console.Docopt.QQ.Instances where

import System.Console.Docopt.Types
import Language.Haskell.TH.Lift

import qualified Data.Map as M

instance (Lift k, Lift v) => Lift (M.Map k v) where
lift m = [| M.fromList assoc |]
where assoc = M.toList m
import Language.Haskell.TH.Syntax (Lift)
import Data.Map.Internal (Map(..))

$(deriveLiftMany [ ''Option
, ''Pattern
, ''OptionInfo
, ''Docopt
])
deriving instance Lift (Map Option OptionInfo)
deriving instance Lift (Docopt)
9 changes: 5 additions & 4 deletions System/Console/Docopt/Types.hs
Original file line number Diff line number Diff line change
@@ -1,11 +1,12 @@
{-# LANGUAGE DeriveLift#-}
module System.Console.Docopt.Types
where

import Data.Char (isUpper)
import Data.List (nub)
import Data.Map (Map)
import qualified Data.Map as M

import Language.Haskell.TH.Syntax (Lift)

-- * Usage expression Types

Expand All @@ -17,7 +18,7 @@ data Pattern a = Sequence [Pattern a]
| Optional (Pattern a)
| Repeated (Pattern a)
| Atom a
deriving (Show, Eq)
deriving (Show, Eq, Lift)

atoms :: Eq a => Pattern a -> [a]
atoms (Sequence ps) = concatMap atoms ps
Expand All @@ -33,7 +34,7 @@ data Option = LongOption Name
| Command Name
| Argument Name
| AnyOption
deriving (Show, Eq, Ord)
deriving (Show, Eq, Ord, Lift)

type OptPattern = Pattern Option

Expand All @@ -57,7 +58,7 @@ data OptionInfo = OptionInfo
, defaultVal :: Maybe String
, expectsVal :: Bool
, isRepeated :: Bool
} deriving (Show, Eq)
} deriving (Show, Eq, Lift)

fromSynList :: [Option] -> OptionInfo
fromSynList opts = OptionInfo { synonyms = opts
Expand Down
2 changes: 1 addition & 1 deletion System/Console/Docopt/UsageParse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ module System.Console.Docopt.UsageParse
import qualified Data.Map as M
import Data.Ord (comparing)
import GHC.Exts (Down(..))
import Data.List (nub, sortBy, maximumBy, dropWhile, dropWhileEnd)
import Data.List (nub, sortBy, maximumBy, dropWhileEnd)

import System.Console.Docopt.ParseUtils
import System.Console.Docopt.Types
Expand Down
13 changes: 8 additions & 5 deletions docopt.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: docopt
version: 0.7.0.6
version: 0.7.0.7
synopsis: A command-line interface parser that will make you smile
description: Docopt parses command-line interface usage text that adheres to a familiar syntax, and from it builds a command-line argument parser that will ensure your program is invoked correctly with the available options specified in the usage text. This allows the developer to write a usage text and get an argument parser for free.

Expand Down Expand Up @@ -57,8 +57,9 @@ library
exposed-modules: System.Console.Docopt
other-modules: System.Console.Docopt.QQ
System.Console.Docopt.QQ.Instances
build-depends: template-haskell >= 2.15.0 && < 2.16,
th-lift >= 0.8.2 && < 0.9
build-depends: template-haskell >= 2.15.0 && < 2.18

default-language: Haskell2010

test-suite tests
type: exitcode-stdio-1.0
Expand All @@ -82,8 +83,8 @@ test-suite tests
aeson,
bytestring,
text,
template-haskell >= 2.15.0 && < 2.16,
th-lift >= 0.8.2 && < 0.9
template-haskell >= 2.15.0 && < 2.18


other-modules: System.Console.Docopt
System.Console.Docopt.ApplicativeParsec
Expand All @@ -95,3 +96,5 @@ test-suite tests
System.Console.Docopt.QQ
System.Console.Docopt.QQ.Instances
Paths_docopt

default-language: Haskell2010
16 changes: 6 additions & 10 deletions stack.yaml
Original file line number Diff line number Diff line change
@@ -1,18 +1,14 @@
# For advanced use and comprehensive documentation of the format, please see:
# http://docs.haskellstack.org/en/stable/yaml_configuration/

resolver: lts-16.20
# ghc 8.10.7
resolver: lts-18.10
# ghc 9.0.1
# resolver: nightly-2021-07-16

packages:
- '.'
- examples/

# Uncomment to test https://github.com/docopt/docopt.hs/issues/29
# extra-deps:
# - aeson-1.0.2.0
# flags:
# aeson:
# fast: true

nix:
enable: true
# nix:
# enable: true
12 changes: 0 additions & 12 deletions stack.yaml.lock

This file was deleted.

0 comments on commit bdc4c67

Please sign in to comment.