diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.4.0.1 +---- +* Loosen version constraints to build back to GHC 7.4.2 +* Remove unused bytestring dependency + 0.4 ---- * Make `Atom` a newtype to help distinguish it from `Text` diff --git a/config-value.cabal b/config-value.cabal --- a/config-value.cabal +++ b/config-value.cabal @@ -1,5 +1,5 @@ name: config-value -version: 0.4 +version: 0.4.0.1 synopsis: Simple, layout-based value language similar to YAML or JSON license: MIT license-file: LICENSE @@ -32,12 +32,11 @@ Config.Pretty, Config.Value - build-depends: base >= 4.7 && < 4.9, - array >= 0.5 && < 0.6, - bytestring >= 0.10.4 && < 0.11, - pretty >= 1.1.1.1 && < 1.2, + build-depends: base >= 4.5 && < 4.9, + array >= 0.4 && < 0.6, + pretty >= 1.1.1.0 && < 1.2, text >= 1.2.0.4 && < 1.3, - transformers >= 0.3 && < 0.5 + transformers >= 0.2 && < 0.5 hs-source-dirs: src build-tools: alex, happy diff --git a/dist/build/Config/Lexer.hs b/dist/build/Config/Lexer.hs --- a/dist/build/Config/Lexer.hs +++ b/dist/build/Config/Lexer.hs @@ -58,12 +58,13 @@ case alexScan inp (stateToInt st) of AlexEOF -> case st of - _ | posColumn (locPosition inp) /= 1 -> [Located (locPosition inp) ErrorUntermFile] - InComment startPosn _ -> [Located startPosn ErrorUntermComment] - InCommentString startPosn _ -> [Located startPosn ErrorUntermCommentString] - InString startPosn b -> [Located startPosn (ErrorUntermString (getStringLit b))] - InNormal -> [Located (locPosition inp){posColumn=0} EOF] - AlexError err -> [fmap (ErrorChar . Text.head) err] + _ | let posn = locPosition inp + , posColumn posn /= 1 -> [Located posn (Error UntermFile)] + InComment posn _ -> [Located posn (Error UntermComment)] + InCommentString posn _ -> [Located posn (Error UntermCommentString)] + InString posn _ -> [Located posn (Error UntermString)] + InNormal -> [Located (locPosition inp){posColumn=0} EOF] + AlexError err -> [fmap (Error. NoMatch . Text.head) err] AlexSkip inp' len -> go st inp' AlexToken inp' len act -> case act (fmap (Text.take len) inp) st of @@ -83,12 +84,12 @@ comment = 1 commentstring = 2 stringlit = 3 -alex_action_2 = token (const OpenMap) -alex_action_3 = token (const CloseMap) -alex_action_4 = token (const OpenList) -alex_action_5 = token (const Comma) -alex_action_6 = token (const CloseList) -alex_action_7 = token (const Bullet) +alex_action_2 = token_ OpenMap +alex_action_3 = token_ CloseMap +alex_action_4 = token_ OpenList +alex_action_5 = token_ Comma +alex_action_6 = token_ CloseList +alex_action_7 = token_ Bullet alex_action_8 = token (number 2 16) alex_action_9 = token (number 0 10) alex_action_10 = token (number 2 8) @@ -99,13 +100,13 @@ alex_action_15 = endString alex_action_16 = addString alex_action_17 = addCharLit -alex_action_19 = badEscape +alex_action_19 = token (Error . BadEscape) alex_action_20 = untermString alex_action_21 = startComment alex_action_22 = endComment alex_action_23 = startCommentString alex_action_26 = endCommentString -alex_action_27 = token (const ErrorUntermCommentString) +alex_action_27 = token_ (Error UntermCommentString) {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -48,7 +48,7 @@ import Config.Parser (parseValue) import Config.Pretty (pretty) import Config.Lexer (scanTokens) -import Config.Tokens (Position(..), Located(..), layoutPass, Token) +import Config.Tokens (Error(..), Position(..), Located(..), layoutPass, Token) import qualified Config.Tokens as T import Numeric (showIntAtBase) @@ -65,19 +65,14 @@ parse txt = case parseValue (layoutPass (scanTokens txt)) of Right x -> Right x - Left (Located posn token) -> Left (errorMessage posn token) + Left (Located posn token) -> Left (explain posn token) -errorMessage :: Position -> Token -> String -errorMessage posn token +explain :: Position -> Token -> String +explain posn token = show (posLine posn) ++ ":" ++ show (posColumn posn) ++ ": " ++ case token of - T.ErrorUntermComment -> "lexical error: unterminated comment" - T.ErrorUntermCommentString -> "lexical error: unterminated string in comment" - T.ErrorUntermString str -> "lexical error: unterminated string: " ++ show str - T.ErrorUntermFile -> "lexical error: unterminated line" - T.ErrorEscape c -> "lexical error in string at: " ++ Text.unpack c - T.ErrorChar c -> "lexical error at character " ++ show c + T.Error e -> explainError e T.Atom atom -> "parse error: unexpected atom: " ++ Text.unpack atom T.String str -> "parse error: unexpected string: " ++ show (Text.unpack str) T.Bullet -> "parse error: unexpected bullet '*'" @@ -94,3 +89,13 @@ T.LayoutSep -> "parse error: unexpected end of block" T.LayoutEnd -> "parse error: unexpected end of block" T.EOF -> "parse error: unexpected end of file" + +explainError :: Error -> String +explainError e = + case e of + T.UntermComment -> "lexical error: unterminated comment" + T.UntermCommentString -> "lexical error: unterminated string literal in comment" + T.UntermString -> "lexical error: unterminated string literal" + T.UntermFile -> "lexical error: unterminated line" + T.BadEscape c -> "lexical error: bad escape sequence: " ++ Text.unpack c + T.NoMatch c -> "lexical error at character " ++ show c diff --git a/src/Config/Lexer.x b/src/Config/Lexer.x --- a/src/Config/Lexer.x +++ b/src/Config/Lexer.x @@ -56,12 +56,12 @@ $white+ ; "--" .* ; -"{" { token (const OpenMap) } -"}" { token (const CloseMap) } -"[" { token (const OpenList) } -"," { token (const Comma) } -"]" { token (const CloseList) } -"*" { token (const Bullet) } +"{" { token_ OpenMap } +"}" { token_ CloseMap } +"[" { token_ OpenList } +"," { token_ Comma } +"]" { token_ CloseList } +"*" { token_ Bullet } "-"? 0 [Xx] @hexadecimal{ token (number 2 16) } "-"? @decimal { token (number 0 10) } "-"? 0 [Oo] @octal { token (number 2 8) } @@ -77,7 +77,7 @@ [^ \" \\ ]+ { addString } \\ @escape { addCharLit } \\ & ; -\\ . { badEscape } +\\ . { token (Error . BadEscape) } \n { untermString } } @@ -94,7 +94,7 @@ { \" { endCommentString } -\n { token (const ErrorUntermCommentString) } +\n { token_ (Error UntermCommentString) } \\ \" ; . ; } @@ -113,12 +113,13 @@ case alexScan inp (stateToInt st) of AlexEOF -> case st of - _ | posColumn (locPosition inp) /= 1 -> [Located (locPosition inp) ErrorUntermFile] - InComment startPosn _ -> [Located startPosn ErrorUntermComment] - InCommentString startPosn _ -> [Located startPosn ErrorUntermCommentString] - InString startPosn b -> [Located startPosn (ErrorUntermString (getStringLit b))] - InNormal -> [Located (locPosition inp){posColumn=0} EOF] - AlexError err -> [fmap (ErrorChar . Text.head) err] + _ | let posn = locPosition inp + , posColumn posn /= 1 -> [Located posn (Error UntermFile)] + InComment posn _ -> [Located posn (Error UntermComment)] + InCommentString posn _ -> [Located posn (Error UntermCommentString)] + InString posn _ -> [Located posn (Error UntermString)] + InNormal -> [Located (locPosition inp){posColumn=0} EOF] + AlexError err -> [fmap (Error. NoMatch . Text.head) err] AlexSkip inp' len -> go st inp' AlexToken inp' len act -> case act (fmap (Text.take len) inp) st of diff --git a/src/Config/LexerUtils.hs b/src/Config/LexerUtils.hs --- a/src/Config/LexerUtils.hs +++ b/src/Config/LexerUtils.hs @@ -18,6 +18,7 @@ import qualified Data.Text.Lazy.Builder as Builder #if !MIN_VERSION_base(4,8,0) +import Data.Functor ((<$)) import Data.Monoid (mempty) #endif @@ -64,6 +65,9 @@ token :: (Text -> Token) -> Action token f match st = (st, Just (fmap f match)) +token_ :: Token -> Action +token_ t match st = (st, Just (t <$ match)) + modeChange :: (Located Text -> LexerMode -> LexerMode) -> Action modeChange f match st = (f match st, Nothing) @@ -118,14 +122,10 @@ [(c,"")] -> InString posn (builder <> Builder.singleton c) _ -> error "addCharLit: Lexer failure" --- | Action for an invalid escape sequence -badEscape :: Action -badEscape = token $ \str -> ErrorEscape str - -- | Action for unterminated string constant untermString :: Action -untermString _ = \(InString posn builder) -> - (InNormal, Just (Located posn (ErrorUntermString (getStringLit builder)))) +untermString _ = \(InString posn _) -> + (InNormal, Just (Located posn (Error UntermString))) ------------------------------------------------------------------------ -- Token builders diff --git a/src/Config/Tokens.hs b/src/Config/Tokens.hs --- a/src/Config/Tokens.hs +++ b/src/Config/Tokens.hs @@ -4,6 +4,7 @@ ( Token(..) , Located(..) , Position(..) + , Error(..) , layoutPass ) where @@ -37,17 +38,21 @@ | OpenMap | CloseMap - | ErrorUntermComment - | ErrorUntermCommentString - | ErrorUntermString Text - | ErrorUntermFile - | ErrorEscape Text - | ErrorChar Char + | Error Error -- "Virtual" tokens used by the subsequent layout processor | LayoutSep | LayoutEnd | EOF + deriving (Show) + +data Error + = UntermComment + | UntermCommentString + | UntermString + | UntermFile + | BadEscape Text + | NoMatch Char deriving (Show) -- | Process a list of position-annotated tokens inserting diff --git a/src/Config/Value.hs b/src/Config/Value.hs --- a/src/Config/Value.hs +++ b/src/Config/Value.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -13,19 +14,30 @@ import Data.Text (Text) import Data.Data (Data, Typeable) import Data.String (IsString(..)) + +#if MIN_VERSION_base(4,6,0) import GHC.Generics (Generic) +#endif -- | A single section of a 'Value' data Section = Section { sectionName :: Text , sectionValue :: Value } - deriving (Eq, Read, Show, Typeable, Data, Generic) + deriving (Eq, Read, Show, Typeable, Data +#if MIN_VERSION_base(4,6,0) + , Generic +#endif + ) -- | Wrapper to distinguish 'Atom' from 'Text' by -- type in a configuration. newtype Atom = MkAtom { atomName :: Text } - deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) + deriving (Eq, Ord, Show, Read, Typeable, Data +#if MIN_VERSION_base(4,6,0) + , Generic +#endif + ) instance IsString Atom where fromString = MkAtom . fromString @@ -37,4 +49,8 @@ | Text Text | Atom Atom | List [Value] - deriving (Eq, Read, Show, Typeable, Data, Generic) + deriving (Eq, Read, Show, Typeable, Data +#if MIN_VERSION_base(4,6,0) + , Generic +#endif + )