Modified cabal file + module contents to be 7.{8,10} compatible

Data/SCargot/Comments.hs

@@ -26,8 +26,6 @@ module Data.SCargot.Comments
   , simpleBlockComment
   ) where
 
-import           Control.Monad (void)
-import           Data.Text (Text)
 import           Text.Parsec ( (<|>)
                              , anyChar
                              , manyTill

Data/SCargot/Common.hs

@@ -19,11 +19,13 @@ module Data.SCargot.Common ( -- $intro
                            , signedHexNumber
                            ) where
 
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative hiding ((<|>), many)
+#endif
 import           Data.Char
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Text.Parsec
-import           Text.Parsec.Char (satisfy)
 import           Text.Parsec.Text (Parser)
 
 -- | Parse an identifier according to the R5RS Scheme standard. This
@@ -184,6 +186,7 @@ decNumber = number 10 digit
 signedDecNumber :: Parser Integer
 signedDecNumber = ($) <$> sign <*> decNumber
 
+dozDigit :: Parser Char
 dozDigit = digit <|> oneOf "AaBb\x218a\x218b"
 
 -- | A parser for non-signed duodecimal (dozenal) numbers. This understands both

Data/SCargot/Language/Basic.hs

@@ -18,7 +18,6 @@ import           Data.SCargot ( SExprParser
                               , mkParser
                               , flatPrint
                               )
-import           Data.SCargot.Comments (withLispComments)
 
 isAtomChar :: Char -> Bool
 isAtomChar c = isAlphaNum c

Data/SCargot/Language/HaskLike.hs

@@ -7,7 +7,9 @@ module Data.SCargot.Language.HaskLike
   , haskLikePrinter
   ) where
 
-import           Control.Applicative ((<$>), (<*>), (<$))
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative ((<$>), (<$))
+#endif
 import           Data.Maybe (catMaybes)
 import           Data.String (IsString(..))
 import           Data.Text (Text, pack)
@@ -52,7 +54,7 @@ instance IsString HaskLikeAtom where
 pString :: Parser Text
 pString = pack . catMaybes <$> between (char '"') (char '"') (many (val <|> esc))
   where val = Just <$> satisfy (\ c -> c /= '"' && c /= '\\' && c > '\026')
-        esc = do char '\\'
+        esc = do _ <- char '\\'
                  Nothing <$ (gap <|> char '&') <|>
                    Just <$> code
         gap  = many1 space >> char '\\'
@@ -84,15 +86,15 @@ pFloat = do
   n <- decNumber
   withDot n <|> noDot n
   where withDot n = do
-          char '.'
+          _ <- char '.'
           m <- decNumber
-          e <- option 1.0 exponent
+          e <- option 1.0 expn
           return ((fromIntegral n + asDec m 0) * e)
         noDot n = do
-          e <- exponent
+          e <- expn
           return (fromIntegral n * e)
-        exponent = do
-          oneOf "eE"
+        expn = do
+          _ <- oneOf "eE"
           s <- power
           x <- decNumber
           return (10 ** s (fromIntegral x))

Data/SCargot/Parse.hs

@@ -19,16 +19,14 @@ module Data.SCargot.Parse
   , withQuote
   ) where
 
-import           Control.Applicative ((<*), (*>), (<*>), (<$>), pure)
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative ((<$>), (<*), pure)
+#endif
 import           Control.Monad ((>=>))
-import           Data.Char (isAlpha, isDigit, isAlphaNum)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import           Data.Maybe (fromJust)
-import           Data.Monoid ((<>))
+import           Data.Text (Text)
 import           Data.String (IsString)
-import           Data.Text (Text, pack, unpack)
-import qualified Data.Text as T
 import           Text.Parsec ( (<|>)
                              , (<?>)
                              , char
@@ -44,9 +42,7 @@ import           Text.Parsec.Text (Parser)
 import           Data.SCargot.Repr ( SExpr(..)
                                    , RichSExpr
                                    , WellFormedSExpr
-                                   , fromRich
                                    , toRich
-                                   , fromWellFormed
                                    , toWellFormed
                                    )
 
@@ -197,14 +193,14 @@ parseList sExpr skip = do
       c <- peekChar
       case c of
         Just '.' -> do
-          char '.'
+          _ <- char '.'
           cdr <- sExpr
           skip
-          char ')'
+          _ <- char ')'
           skip
           return (SCons car cdr)
         Just ')' -> do
-          char ')'
+          _ <- char ')'
           skip
           return (SCons car SNil)
         _ -> do

Data/SCargot/Repr.hs

@@ -20,11 +20,14 @@ module Data.SCargot.Repr
 
 import Data.Data (Data)
 import Data.Foldable (Foldable(..))
-import Data.Monoid (Monoid(..), (<>))
 import Data.Traversable (Traversable(..))
 import Data.Typeable (Typeable)
 import GHC.Exts (IsList(..), IsString(..))
 
+#if !MIN_VERSION_base(4,8,0)
+import Prelude hiding (foldr)
+#endif
+
 -- | All S-Expressions can be understood as a sequence
 --   of @cons@ cells (represented here by 'SCons'), the
 --   empty list @nil@ (represented by 'SNil') or an
@@ -85,7 +88,8 @@ toRich (SAtom a) = RSAtom a
 toRich (SCons x xs) = go xs (toRich x:)
   where go (SAtom a) rs    = RSDotted (rs []) a
         go SNil rs         = RSList (rs [])
-        go (SCons x xs) rs = go xs (rs . (toRich x:))
+        go (SCons y ys) rs = go ys (rs . (toRich y:))
+toRich SNil = RSList []
 
 -- | This follows the same laws as 'toRich'.
 fromRich :: RichSExpr atom -> SExpr atom
@@ -128,11 +132,11 @@ toWellFormed (SAtom a) = return (WFSAtom a)
 toWellFormed (SCons x xs) = do
   x' <- toWellFormed x
   go xs (x':)
-  where go (SAtom a) rs = Left "Found atom in cdr position"
+  where go (SAtom _) _  = Left "Found atom in cdr position"
         go SNil rs      = return (WFSList (rs []))
-        go (SCons x xs) rs = do
-          x' <- toWellFormed x
-          go xs (rs . (x':))
+        go (SCons y ys) rs = do
+          y' <- toWellFormed y
+          go ys (rs . (y':))
 
 -- | Convert a WellFormedSExpr back into a SExpr.
 fromWellFormed :: WellFormedSExpr atom -> SExpr atom

Data/SCargot/Repr/Basic.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Data.SCargot.Repr.Basic
@@ -27,7 +28,9 @@ module Data.SCargot.Repr.Basic
        , asAssoc
        ) where
 
-import Control.Applicative ((<$>), (<*>), pure)
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative (Applicative, (<$>), (<*>), pure)
+#endif
 import Data.SCargot.Repr as R
 
 -- | A traversal with access to the first element of a pair.
@@ -38,9 +41,9 @@ import Data.SCargot.Repr as R
 -- >>> set _car (A "two" ::: A "three" ::: Nil) (A "one" ::: A "elephant")
 -- (A "two" ::: A "three" ::: Nil) ::: A "elephant"
 _car :: Applicative f => (SExpr a -> f (SExpr a)) -> SExpr a -> f (SExpr a)
-_car f (x ::: xs) = (:::) <$> f x <*> pure xs
-_car _ (A a)      = pure (A a)
-_car _ Nil        = pure Nil
+_car f (SCons x xs) = (:::) <$> f x <*> pure xs
+_car _ (SAtom a)    = pure (A a)
+_car _ SNil         = pure SNil
 
 -- | A traversal with access to the second element of a pair.
 --
@@ -50,9 +53,9 @@ _car _ Nil        = pure Nil
 -- >>> set _cdr (A "two" ::: A "three" ::: Nil) (A "one" ::: A "elephant")
 -- A "one" ::: A "two" ::: A "three" ::: Nil
 _cdr :: Applicative f => (SExpr a -> f (SExpr a)) -> SExpr a -> f (SExpr a)
-_cdr f (x ::: xs) = (:::) <$> pure x <*> f xs
-_cdr _ (A a)      = pure (A a)
-_cdr _ Nil        = pure Nil
+_cdr f (SCons x xs) = (:::) <$> pure x <*> f xs
+_cdr _ (SAtom a)    = pure (A a)
+_cdr _ SNil         = pure Nil
 
 -- | Produce the head and tail of the s-expression (if possible).
 --
@@ -112,21 +115,26 @@ pattern Nil = SNil
 -- >>> L [A "pachy", A "derm"]
 -- SCons (SAtom "pachy") (SCons (SAtom "derm") SNil)
 pattern L xs <- (gatherList -> Right xs)
+#if MIN_VERSION_base(4,8,0)
   where L xs = mkList xs
+#endif
+
 
 -- | An alias for matching a dotted list.
 --
 -- >>> DL [A "pachy"] A "derm"
 -- SCons (SAtom "pachy") (SAtom "derm")
 pattern DL xs x <- (gatherDList -> Just (xs, x))
+#if MIN_VERSION_base(4,8,0)
   where DL xs x = mkDList xs x
+#endif
 
 getShape :: SExpr a -> String
 getShape Nil = "empty list"
-getShape sx = go 0 sx
-  where go n Nil      = "list of length " ++ show n
-        go n A {}     = "dotted list of length " ++ show n
-        go n (_:::xs) = go (n+1) xs
+getShape sx = go (0 :: Int) sx
+  where go n SNil         = "list of length " ++ show n
+        go n SAtom {}     = "dotted list of length " ++ show n
+        go n (SCons _ xs) = go (n+1) xs
 
 -- | Utility function for parsing a pair of things.
 --
@@ -143,7 +151,7 @@ fromPair _  _  sx = Left ("fromPair: expected two-element list; found " ++ getSh
 -- | Utility function for parsing a list of things.
 fromList :: (SExpr t -> Either String a) -> SExpr t -> Either String [a]
 fromList p (s ::: ss) = (:) <$> p s <*> fromList p ss
-fromList p Nil        = pure []
+fromList _ Nil        = pure []
 fromList _ sx         = Left ("fromList: expected list; found " ++ getShape sx)
 
 -- | Utility function for parsing a single atom

Data/SCargot/Repr/Rich.hs

@@ -28,9 +28,13 @@ module Data.SCargot.Repr.Rich
        , isNil
        , asAtom
        , asAssoc
+       , car
+       , cdr
        ) where
 
-import Control.Applicative ((<$>), (<*>), pure)
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative (Applicative, (<$>), (<*>), pure)
+#endif
 import Data.SCargot.Repr as R
 
 -- | A traversal with access to the first element of a pair.
@@ -41,10 +45,11 @@ import Data.SCargot.Repr as R
 -- >>> set _car (L [A "two", A "three"]) (DL [A "one"] "elephant")
 -- DL [L[A "two",A "three"]] "elephant"
 _car :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a)
-_car f (L (x:xs))    = (\ x -> L (x:xs)) `fmap` f x
-_car f (DL (x:xs) a) = (\ x -> DL (x:xs) a) `fmap` f x
-_car _ (A a)         = pure (A a)
-_car _ Nil           = pure Nil
+_car f (RSList (x:xs))     = (\ y -> L (y:xs)) `fmap` f x
+_car f (RSDotted (x:xs) a) = (\ y -> DL (y:xs) a) `fmap` f x
+_car _ (RSAtom a)          = pure (A a)
+_car _ (RSList [])         = pure Nil
+_car _ (RSDotted [] a)     = pure (A a)
 
 -- | A traversal with access to the second element of a pair. Using
 --   this to modify an s-expression may result in changing the
@@ -57,32 +62,36 @@ _car _ Nil           = pure Nil
 -- >>> set _cdr (L [A "two", A "three"]) (DL [A "one"] "elephant")
 -- L [A "one",A "two",A "three"]
 _cdr :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a)
-_cdr f (L (x:xs)) =
-  let go Nil     = L [x]
-      go (A a)   = DL [x] a
-      go (L xs') = L (x:xs')
+_cdr f (RSList (x:xs)) =
+  let go (RSList [])      = L [x]
+      go (RSAtom a)       = DL [x] a
+      go (RSList xs')     = L (x:xs')
+      go (RSDotted ys a') = DL (x:ys) a'
   in go `fmap` f (L xs)
-_cdr f (DL [x] a) =
-  let go Nil    = L [x]
-      go (A a') = DL [x] a'
-      go (L xs) = L (x:xs)
+_cdr f (RSDotted [x] a) =
+  let go (RSList [])      = L [x]
+      go (RSAtom a')      = DL [x] a'
+      go (RSList xs)      = L (x:xs)
+      go (RSDotted ys a') = DL (x:ys) a'
   in go `fmap` f (A a)
-_cdr f (DL (x:xs) a) =
-  let go Nil    = L [x]
-      go (A a') = DL [x] a'
-      go (L xs) = L (x:xs)
+_cdr f (RSDotted (x:xs) a) =
+  let go (RSList [])      = L [x]
+      go (RSAtom a')      = DL [x] a'
+      go (RSList ys)      = L (x:ys)
+      go (RSDotted ys a') = DL (x:ys) a'
   in go `fmap` f (DL xs a)
-_cdr _ (A a)      = pure (A a)
-_cdr _ Nil        = pure Nil
+_cdr _ (RSAtom a)         = pure (A a)
+_cdr _ (RSList [])        = pure Nil
+_cdr _ (RSDotted [] a)    = pure (A a)
 
 -- | Produce the head and tail of the s-expression (if possible).
 --
 -- >>> uncons (L [A "el", A "eph", A "ant"])
 -- Just (A "el",L [A "eph",A "ant"])
 uncons :: RichSExpr a -> Maybe (RichSExpr a, RichSExpr a)
-uncons R.RSAtom {}           = Nothing
 uncons (R.RSList (x:xs))     = Just (x, R.RSList xs)
 uncons (R.RSDotted (x:xs) a) = Just (x, R.RSDotted xs a)
+uncons _                     = Nothing
 
 -- | Combine the two s-expressions into a new one.
 --
@@ -99,7 +108,9 @@ cons x (R.RSAtom a)      = R.RSDotted [x] a
 -- >>> A "one" ::: L [A "two", A "three"]
 -- RSList [RSAtom "one",RSAtom "two",RSAtom "three"]
 pattern x ::: xs <- (uncons -> Just (x, xs))
+#if MIN_VERSION_base(4,8,0)
   where x ::: xs = cons x xs
+#endif
 
 -- | A shorter alias for `RSAtom`
 --
@@ -153,9 +164,9 @@ fromList p = asList $ \ss -> mapM p ss
 -- >>> fromAtom (L [A "elephant"])
 -- Left "fromAtom: expected atom; found list"
 fromAtom :: RichSExpr t -> Either String t
-fromAtom (L _)    = Left "fromAtom: expected atom; found list"
-fromAtom (DL _ _) = Left "fromAtom: expected atom; found dotted list"
-fromAtom (A a)    = return a
+fromAtom (RSList _)     = Left "fromAtom: expected atom; found list"
+fromAtom (RSDotted _ _) = Left "fromAtom: expected atom; found dotted list"
+fromAtom (RSAtom a)     = return a
 
 -- | Parses a two-element list using the provided function.
 --
@@ -166,10 +177,10 @@ fromAtom (A a)    = return a
 -- Left "asPair: expected two-element list; found list of length 1"
 asPair :: ((RichSExpr t, RichSExpr t) -> Either String a)
        -> RichSExpr t -> Either String a
-asPair f (L [l, r]) = f (l, r)
-asPair _ (L ls)     = Left ("asPair: expected two-element list; found list of lenght " ++ show (length ls))
-asPair _ DL {}      = Left ("asPair: expected two-element list; found dotted list")
-asPair _ A {}       = Left ("asPair: expected two-element list; found atom")
+asPair f (RSList [l, r]) = f (l, r)
+asPair _ (RSList ls)     = Left ("asPair: expected two-element list; found list of lenght " ++ show (length ls))
+asPair _ RSDotted {}     = Left ("asPair: expected two-element list; found dotted list")
+asPair _ RSAtom {}       = Left ("asPair: expected two-element list; found atom")
 
 -- | Parse an arbitrary-length list using the provided function.
 --
@@ -180,9 +191,9 @@ asPair _ A {}       = Left ("asPair: expected two-element list; found atom")
 -- Left "asList: expected list; found dotted list"
 asList :: ([RichSExpr t] -> Either String a)
        -> RichSExpr t -> Either String a
-asList f (L ls) = f ls
-asList _ DL {}  = Left ("asList: expected list; found dotted list")
-asList _ A { }  = Left ("asList: expected list; found dotted list")
+asList f (RSList ls) = f ls
+asList _ RSDotted {} = Left ("asList: expected list; found dotted list")
+asList _ RSAtom { }  = Left ("asList: expected list; found dotted list")
 
 -- | Match a given literal atom, failing otherwise.
 --
@@ -191,11 +202,11 @@ asList _ A { }  = Left ("asList: expected list; found dotted list")
 -- >>> isAtom "elephant" (L [A "elephant"])
 -- Left "isAtom: expected atom; found list"
 isAtom :: Eq t => t -> RichSExpr t -> Either String ()
-isAtom s (A s')
+isAtom s (RSAtom s')
   | s == s'   = return ()
   | otherwise = Left "isAtom: failed to match atom"
-isAtom _ L {}  = Left "isAtom: expected atom; found list"
-isAtom _ DL {} = Left "isAtom: expected atom; found dotted list"
+isAtom _ RSList {}  = Left "isAtom: expected atom; found list"
+isAtom _ RSDotted {} = Left "isAtom: expected atom; found dotted list"
 
 -- | Match an empty list, failing otherwise.
 --
@@ -204,10 +215,10 @@ isAtom _ DL {} = Left "isAtom: expected atom; found dotted list"
 -- >>> isNil (A "elephant")
 -- Left "isNil: expected nil; found atom"
 isNil :: RichSExpr t -> Either String ()
-isNil Nil   = return ()
-isNil L {}  = Left "isNil: expected nil; found non-nil list"
-isNil DL {} = Left "isNil: expected nil; found dotted list"
-isNil A {}  = Left "isNil: expected nil; found atom"
+isNil (RSList []) = return ()
+isNil RSList {}   = Left "isNil: expected nil; found non-nil list"
+isNil RSDotted {} = Left "isNil: expected nil; found dotted list"
+isNil RSAtom {}   = Left "isNil: expected nil; found atom"
 
 -- | Parse an atom using the provided function.
 --
@@ -217,9 +228,9 @@ isNil A {}  = Left "isNil: expected nil; found atom"
 -- >>> asAtom (return . map toUpper) (L [])
 -- Left "asAtom: expected atom; found list"
 asAtom :: (t -> Either String a) -> RichSExpr t -> Either String a
-asAtom f (A s) = f s
-asAtom _ L {}  = Left ("asAtom: expected atom; found list")
-asAtom _ DL {} = Left ("asAtom: expected atom; found dotted list")
+asAtom f (RSAtom s)  = f s
+asAtom _ RSList {}   = Left ("asAtom: expected atom; found list")
+asAtom _ RSDotted {} = Left ("asAtom: expected atom; found dotted list")
 
 -- | Parse an assoc-list using the provided function.
 --
@@ -231,14 +242,14 @@ asAtom _ DL {} = Left ("asAtom: expected atom; found dotted list")
 -- Left "asAssoc: expected pair; found list of length 1"
 asAssoc :: ([(RichSExpr t, RichSExpr t)] -> Either String a)
         -> RichSExpr t -> Either String a
-asAssoc f (L ss) = gatherPairs ss >>= f
-  where gatherPairs (L [a, b] : ss) = (:) <$> pure (a, b) <*> gatherPairs ss
+asAssoc f (RSList ss) = gatherPairs ss >>= f
+  where gatherPairs (RSList [a, b] : ts) = (:) <$> pure (a, b) <*> gatherPairs ts
         gatherPairs []              = pure []
-        gatherPairs (A {} : _)      = Left ("asAssoc: expected pair; found atom")
-        gatherPairs (DL {} : _)     = Left ("asAssoc: expected pair; found dotted list")
-        gatherPairs (L ls : _)      = Left ("asAssoc: expected pair; found list of length " ++ show (length ls))
-asAssoc f DL {}     = Left "asAssoc: expected assoc list; found dotted list"
-asAssoc f A {}      = Left "asAssoc: expected assoc list; found atom"
+        gatherPairs (RSAtom {} : _)      = Left ("asAssoc: expected pair; found atom")
+        gatherPairs (RSDotted {} : _)     = Left ("asAssoc: expected pair; found dotted list")
+        gatherPairs (RSList ls : _)      = Left ("asAssoc: expected pair; found list of length " ++ show (length ls))
+asAssoc _ RSDotted {} = Left "asAssoc: expected assoc list; found dotted list"
+asAssoc _ RSAtom {}   = Left "asAssoc: expected assoc list; found atom"
 
 car :: (RichSExpr t -> Either String t') -> [RichSExpr t] -> Either String t'
 car f (x:_) = f x

Data/SCargot/Repr/WellFormed.hs

@@ -21,13 +21,16 @@ module Data.SCargot.Repr.WellFormed
        , asPair
        , asList
        , isAtom
+       , isNil
        , asAtom
        , asAssoc
        , car
        , cdr
        ) where
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>), (<*>), pure)
+#endif
 import Data.SCargot.Repr as R
 
 -- | Produce the head and tail of the s-expression (if possible).
@@ -36,6 +39,7 @@ import Data.SCargot.Repr as R
 -- Just (WFSAtom "el",WFSList [WFSAtom "eph",WFSAtom "ant"])
 uncons :: WellFormedSExpr a -> Maybe (WellFormedSExpr a, WellFormedSExpr a)
 uncons R.WFSAtom {}       = Nothing
+uncons (R.WFSList [])     = Nothing
 uncons (R.WFSList (x:xs)) = Just (x, R.WFSList xs)
 
 -- | Combine the two-expressions into a new one. This will return
@@ -76,9 +80,9 @@ pattern A a  = R.WFSAtom a
 pattern Nil = R.WFSList []
 
 getShape :: WellFormedSExpr a -> String
-getShape A {}   = "atom"
-getShape Nil    = "empty list"
-getShape (L sx) = "list of length " ++ show (length sx)
+getShape WFSAtom {}   = "atom"
+getShape (WFSList []) = "empty list"
+getShape (WFSList sx) = "list of length " ++ show (length sx)
 
 -- | Utility function for parsing a pair of things.
 --
@@ -181,7 +185,7 @@ asAtom _ sx    = Left ("asAtom: expected atom; found " ++ getShape sx)
 asAssoc :: ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
         -> WellFormedSExpr t -> Either String a
 asAssoc f (L ss) = gatherPairs ss >>= f
-  where gatherPairs (L [a, b] : ss) = (:) <$> pure (a, b) <*> gatherPairs ss
+  where gatherPairs (L [a, b] : ts) = (:) <$> pure (a, b) <*> gatherPairs ts
         gatherPairs []              = pure []
         gatherPairs (sx:_)          = Left ("asAssoc: expected pair; found " ++ getShape sx)
 asAssoc _ sx     = Left ("asAssoc: expected list; found " ++ getShape sx)

s-cargot.cabal

@@ -35,8 +35,10 @@ library
                        Data.SCargot.Common,
                        Data.SCargot.Language.Basic,
                        Data.SCargot.Language.HaskLike
-  build-depends:       base >=4.7 && <5,
-                       parsec,
-                       text,
-                       containers
+  build-depends:       base        >=4.7 && <5,
+                       parsec      >=3.1 && <4,
+                       text        >=1.2 && <2,
+                       containers  >=0.5 && <1
   default-language:    Haskell2010
+  default-extensions:  CPP
+  ghc-options:         -Wall