Improve codebase

Data/SGF.hs → lib/Data/SGF.hs

@@ -7,10 +7,7 @@ There are plans to support other games and pretty-printing in future releases.
 -}
 module Data.SGF (
     module Data.SGF.Types,
-    module Data.SGF.Parse,
-    module Data.Word,
-    module Data.Tree,
-    module Text.ParserCombinators.Parsec
+    collection,
     -- * Overview of SGF
     -- $sgf
 
@@ -19,14 +16,23 @@ module Data.SGF (
 
     -- * Example usage
     -- $example
+
+    -- * Convenience reexports
+    Word8,
+    Tree(..), levels,
+    runParser,
+    B.ByteString, B.getContents, B.unpack, B.readFile
 ) where
 
 import Data.SGF.Types
 import Data.SGF.Parse (collection)
-import Data.Word
-import Data.Tree
+
+import Data.Word (Word8)
+import Data.Tree (Tree(..), levels)
 import Text.ParserCombinators.Parsec (runParser)
 
+import qualified Data.ByteString as B
+
 -- TODO:
 -- * support parsing from ByteString, then take the "unpack" out of "parse" below
 -- * support the rest of the SGF format ;-)
@@ -99,8 +105,6 @@ obscure the idea.)
 First, some boring stuff.
 
 > import Data.SGF
-> import Data.ByteString  (ByteString, getContents, unpack)
-> import Data.Tree
 > import Data.List hiding ((!!))
 > import Prelude   hiding ((!!), getContents)
 >

lib/Data/SGF/Parse.hs

@@ -0,0 +1,5 @@
+module Data.SGF.Parse (
+        module Data.SGF.Parse.Internal
+    ) where
+
+import Data.SGF.Parse.Internal

lib/Data/SGF/Types.hs

@@ -0,0 +1,5 @@
+module Data.SGF.Types (
+        module Data.SGF.Types.Internal,
+    ) where
+
+import Data.SGF.Types.Internal

sgf.cabal

@@ -1,7 +1,8 @@
+cabal-version:      3.0
 name:               sgf
 version:            0.1.3.3
 author:             Daniel Wagner daniel@wagner-home.com
-maintainer:         Toni Cebrián ancechu@gmail.com 
+maintainer:         Toni Cebrián ancechu@gmail.com
 homepage:           https://github.com/tonicebrian/sgf
 bug-reports:        https://github.com/tonicebrian/sgf/issues
 synopsis:           SGF (Smart Game Format) parser
@@ -12,28 +13,55 @@ description:
     editors.  There are plans to support other games and pretty-printing in
     future releases.
 category:           Data
-license:            BSD3
+license:            BSD-3-Clause
 license-file:       LICENSE
-cabal-version:      >= 1.10
 build-type:         Simple
 
-library
+common shared
+    build-depends:      base == 4.*,
+    ghc-options:        -Wall
     default-language:   Haskell2010
-    exposed-modules:    Data.SGF
-                        Data.SGF.Parse
+
+library
+    import:             shared
+    exposed-modules:    Data.SGF,
+                        Data.SGF.Parse,
                         Data.SGF.Types
-    other-modules:      Data.SGF.Parse.Encodings
-                        Data.SGF.Parse.Raw
+    build-depends:      sgf-internal,
+                        bytestring >= 0.11.5.3 && < 0.13,
+                        containers >= 0.6.7 && < 0.9,
+                        parsec >= 3.1.16 && < 3.2
+    hs-source-dirs:     lib/
+
+library sgf-internal
+    import:             shared
+    visibility:         private
+    exposed-modules:    Data.SGF.Parse.Internal,
+                        Data.SGF.Types.Internal,
+                        Data.SGF.Parse.Encodings,
+                        Data.SGF.Parse.Raw,
                         Data.SGF.Parse.Util
-    build-depends:  base >=3 && < 5,
-                    containers >= 0.6.7 && < 0.7,
-                    encoding >= 0.8.9 && < 0.9,
-                    extensible-exceptions >= 0.1.1 && < 0.2,
-                    mtl >= 2.2.2,
-                    transformers >= 0.5.6,
-                    time >= 1.12.2 && < 1.13,
-                    split >= 0.2.5,
-                    parsec >= 3.1.16 && < 3.2
+    build-depends:      bytestring >= 0.11.5.3 && < 0.13,
+                        containers >= 0.6.7 && < 0.9,
+                        encoding >= 0.8.9 && < 0.11,
+                        extensible-exceptions >= 0.1.1 && < 0.2,
+                        mtl >= 2.2.2 && < 2.4,
+                        transformers >= 0.5.6 && < 0.7,
+                        time >= 1.12.2 && < 1.16,
+                        split >= 0.2.5 && < 0.3,
+                        parsec >= 3.1.16 && < 3.2
+    hs-source-dirs:     src/
+
+test-suite test
+    import:             shared
+    main-is:            Test.hs
+    other-modules:      Unit.Data.SGF.Parse.EncodingsSpec
+    build-depends:      sgf-internal,
+                        hspec >= 2.10.10 && < 2.12,
+    build-tool-depends: hspec-discover:hspec-discover
+    hs-source-dirs:     test
+    type:               exitcode-stdio-1.0
+
 
 source-repository head
     type:       git

Data/SGF/Parse/Encodings.hs → src/Data/SGF/Parse/Encodings.hs

@@ -1,16 +1,13 @@
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
 
-module Data.SGF.Parse.Encodings
-    ( guessEncoding
-    , decodeWordStringExplicit
+module Data.SGF.Parse.Encodings (
+        module Data.SGF.Parse.Encodings,
+        encodingFromString
     ) where
 
-import Control.Applicative (Applicative(..))
-import Control.Exception.Extensible
 import Control.Monad (ap, liftM)
 import Control.Monad.State
 import Control.Throws
 import Data.Encoding
@@ -27,13 +24,13 @@
 
 instance Applicative (MyEither a) where
     pure :: a2 -> MyEither a1 a2
-    pure x = return x -- note that an eta reduced version of this trips the type checker for non-canonical "pure = return"
+    pure x = MyEither (Right x)
     (<*>) :: MyEither a1 (a2 -> b) -> MyEither a1 a2 -> MyEither a1 b
     (<*>) = ap
 
 instance Monad (MyEither a) where
     (MyEither (Right x)) >>= f = f x
-    (MyEither (Left x)) >>= f = MyEither (Left x)
+    (MyEither (Left x)) >>= _ = MyEither (Left x)
 
 instance ByteSource (StateT [Word8] (MyEither DecodingException)) where
     sourceEmpty = gets null
@@ -49,8 +46,10 @@
         return v
 
 -- some ones that we know satisfy our invariant (see SGF.Parse.Raw)
+encodings :: [DynEncoding]
 encodings = map encodingFromString ["latin1", "utf-8", "ascii"]
 
+guess :: [Word8] -> DynEncoding -> Bool
 guess ws encoding =
     case runStateT (decode encoding) ws :: MyIHateGHC of
         (MyEither (Right (s, []))) ->

Data/SGF/Parse.hs → src/Data/SGF/Parse/Internal.hs

@@ -8,7 +8,7 @@
 -- boilerplate {{{
 -- TODO: check that every occurrence of "die" should really be a death, and not just a "fix-it-up-and-warn"
 -- boilerplate {{{
-module Data.SGF.Parse
+module Data.SGF.Parse.Internal
     ( collection
     , clipDate
     , PropertyType(..)
@@ -23,8 +23,8 @@
 import Control.Applicative
 import Control.Arrow
 import Control.Monad
 import Control.Monad.Fail
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer
 import Data.Bits
@@ -40,28 +40,28 @@
 import Data.SGF.Parse.Raw hiding (collection)
 import qualified Data.SGF.Parse.Raw as Raw
 import Data.SGF.Parse.Util
-import Data.SGF.Types (Game(Game), GameNode(GameNode))
-import Data.SGF.Types hiding
+import Data.SGF.Types.Internal (Game(Game), GameNode(GameNode))
+import Data.SGF.Types.Internal hiding
     ( Game(..)
     , GameInfo(..)
     , GameNode(..)
     , Move(..)
     , Setup(..)
     )
-import qualified Data.SGF.Types as T
+import qualified Data.SGF.Types.Internal as T
 import qualified Data.Set as Set
 import Data.Time.Calendar
 import Data.Tree
 import Data.Word
 import Prelude hiding (round)
 import Text.Parsec hiding (newline)
 import Text.Parsec.Pos (newPos)
 
 instance MonadFail (Either Error) where
     fail :: String -> Either Error a
     fail msg = Left (UnknownError (Just msg))
 
 translate trans state =
     case runStateT (runWriterT trans) state of
         Left (UnknownError Nothing) -> fail ""
         Left (UnknownError (Just e)) -> fail e
@@ -77,7 +77,7 @@
 -- two kinds of errors in SGF files: recoverable ones (which will be
 -- accumulated in the ['Warning'] return) and unrecoverable ones (which will
 -- result in parse errors).
-collection :: Stream s m Word8 => ParsecT s u m (Collection, [Warning])
+collection :: SGFParser (Collection, [Warning])
 collection =
     second concat . unzip <$> (mapM (translate gameTree) =<< Raw.collection)
 

Data/SGF/Parse/Raw.hs → src/Data/SGF/Parse/Raw.hs

@@ -3,6 +3,7 @@
 module Data.SGF.Parse.Raw (
     collection,
     Property(..),
+    SGFParser,
     enum
 ) where
 
@@ -12,9 +13,12 @@ import Data.Char
 import Data.Tree
 import Data.Word
 import Prelude hiding (lex)
-import Text.Parsec (SourcePos(..), incSourceColumn)
+import Text.Parsec (SourcePos, incSourceColumn)
 import Text.Parsec.Prim
 import Text.Parsec.Combinator
+
+type SGFParser a = Parsec [Word8] () a
+
 -- }}}
 data Property = Property {
     position :: SourcePos, -- ^
@@ -38,50 +42,62 @@ data Property = Property {
 -- things.
 enum :: (Enum a, Enum b) => a -> b
 enum = toEnum . fromEnum
+ensure :: (Monad m, Alternative m) => (b -> Bool) -> b -> m b
 ensure p x = guard (p x) >> return x
 
+satisfy :: (Word8 -> Bool) -> SGFParser Word8
 satisfy p = tokenPrim
     ((\x -> ['\'', x, '\'']) . enum)
     (\pos _ _ -> incSourceColumn pos 1)
     (ensure p)
+satisfyChar :: Enum b => (b -> Bool) -> SGFParser Word8
 satisfyChar = satisfy . (. enum)
 
+anyWord :: SGFParser Word8
 anyWord     = satisfy (const True)
+exactWord :: Char -> SGFParser Word8
 exactWord   = satisfy . (==) . enum
-someWord    = satisfy . flip elem . map enum
+noWord :: [Char] -> SGFParser Word8
 noWord      = satisfy . flip notElem . map enum
 
+whitespace :: SGFParser [Word8]
 whitespace  = many (satisfyChar isSpace)
 
 -- assumed: the current byte is literally ASCII '\\' iff the current byte is
 -- the last byte of the encoding of the actual character '\\' and neither of
 -- the bytes that are literally ASCII ']' and ASCII ':' occur after the first
 -- byte of any multi-byte encoded character
 -- (in particular, UTF-8, ASCII, and ISO 8859-1 satisfy this property)
+escapedChar :: SGFParser [Word8]
 escapedChar             = liftM2 (\x y -> [x, y]) (exactWord '\\') anyWord
+unescapedExcept :: [Char] -> SGFParser [Word8]
 unescapedExcept      ws = fmap return (noWord ws)
+literalTextExcept :: [Char] -> SGFParser [Word8]
 literalTextExcept    ws = fmap concat $ many (escapedChar <|> unescapedExcept ws)
 
+property :: SGFParser Property
 property = liftM3 ((. map enum) . Property)
     (getPosition)
     (many1 (satisfyChar (liftM2 (&&) isUpper (< '\128'))))
     (sepEndBy1 (exactWord '[' >> literalTextExcept "]" <* exactWord ']') whitespace)
 
+node :: SGFParser [Property]
 node = do
-    exactWord ';'
-    whitespace
+    _ <- exactWord ';'
+    _ <- whitespace
     sepEndBy property whitespace
 
+gameTree :: SGFParser (Tree [Property])
 gameTree = do
-    exactWord '('
-    whitespace
-    (node:nodes) <- sepEndBy1 node     whitespace
+    _ <- exactWord '('
+    _ <- whitespace
+    (node':nodes) <- sepEndBy1 node     whitespace
     trees        <- sepEndBy  gameTree whitespace
-    exactWord ')'
-    return (Node node (foldr ((return .) . Node) trees nodes))
+    _ <- exactWord ')'
+    return (Node node' (foldr ((return .) . Node) trees nodes))
 
 -- |
 -- Parse the tree-structure of an SGF file, but without any knowledge of the
 -- semantics of the properties, etc.
-collection :: Stream s m Word8 => ParsecT s u m [Tree [Property]]
+collection :: SGFParser [Tree [Property]]
 collection = whitespace >> sepEndBy1 gameTree whitespace <* whitespace <* eof