-- boilerplate {{{
{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}
module Data.SGF.Parse.Raw (
    collection,
    Property(..),
    enum
) where

import Control.Applicative hiding (many, (<|>))
import Control.Monad
import Data.Char
import Data.Tree
import Data.Word
import Prelude hiding (lex)
import Text.Parsec (SourcePos(..), incSourceColumn)
import Text.Parsec.Prim
import Text.Parsec.Combinator
-- }}}
data Property = Property {
    Property -> SourcePos
position :: SourcePos, -- ^
                           -- Currently, this is pretty lame: it doesn't track
                           -- line number and character number, only byte
                           -- offset from the beginning of the file.  This is
                           -- because I don't really understand how to
                           -- correctly track line number and character number
                           -- properly in the face of dynamically changing
                           -- encodings, whereas byte number is a totally
                           -- braindead statistic to track.
    Property -> String
name     :: String,    -- ^
                           -- The literal name of the property.  This is
                           -- guaranteed to be a non-empty string of
                           -- upper-case ASCII characters.
    Property -> [[Word8]]
values   :: [[Word8]]  -- ^ The arguments to the property.
} deriving (Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq, Eq Property
Eq Property =>
(Property -> Property -> Ordering)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Property)
-> (Property -> Property -> Property)
-> Ord Property
Property -> Property -> Bool
Property -> Property -> Ordering
Property -> Property -> Property
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Property -> Property -> Ordering
compare :: Property -> Property -> Ordering
$c< :: Property -> Property -> Bool
< :: Property -> Property -> Bool
$c<= :: Property -> Property -> Bool
<= :: Property -> Property -> Bool
$c> :: Property -> Property -> Bool
> :: Property -> Property -> Bool
$c>= :: Property -> Property -> Bool
>= :: Property -> Property -> Bool
$cmax :: Property -> Property -> Property
max :: Property -> Property -> Property
$cmin :: Property -> Property -> Property
min :: Property -> Property -> Property
Ord, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Property -> ShowS
showsPrec :: Int -> Property -> ShowS
$cshow :: Property -> String
show :: Property -> String
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show)

-- |
-- Handy way to convert known-ASCII characters from 'Word8' to 'Char', among other
-- things.
enum :: (Enum a, Enum b) => a -> b
enum :: forall a b. (Enum a, Enum b) => a -> b
enum = Int -> b
forall a. Enum a => Int -> a
toEnum (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum
ensure :: (b -> Bool) -> b -> m b
ensure b -> Bool
p b
x = Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (b -> Bool
p b
x) m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x

satisfy :: (a -> Bool) -> ParsecT s u m a
satisfy a -> Bool
p = (a -> String)
-> (SourcePos -> a -> s -> SourcePos)
-> (a -> Maybe a)
-> ParsecT s u m a
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim
    ((\Char
x -> [Char
'\'', Char
x, Char
'\'']) (Char -> String) -> (a -> Char) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Char
forall a b. (Enum a, Enum b) => a -> b
enum)
    (\SourcePos
pos a
_ s
_ -> SourcePos -> Int -> SourcePos
incSourceColumn SourcePos
pos Int
1)
    ((a -> Bool) -> a -> Maybe a
forall {m :: * -> *} {b}.
(Monad m, Alternative m) =>
(b -> Bool) -> b -> m b
ensure a -> Bool
p)
satisfyChar :: (b -> Bool) -> ParsecT s u m a
satisfyChar = (a -> Bool) -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
(a -> Bool) -> ParsecT s u m a
satisfy ((a -> Bool) -> ParsecT s u m a)
-> ((b -> Bool) -> a -> Bool) -> (b -> Bool) -> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (Enum a, Enum b) => a -> b
enum)

anyWord :: ParsecT s u m a
anyWord     = (a -> Bool) -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
(a -> Bool) -> ParsecT s u m a
satisfy (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
exactWord :: a -> ParsecT s u m a
exactWord   = (a -> Bool) -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
(a -> Bool) -> ParsecT s u m a
satisfy ((a -> Bool) -> ParsecT s u m a)
-> (a -> a -> Bool) -> a -> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> (a -> a) -> a -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a b. (Enum a, Enum b) => a -> b
enum
someWord :: [a] -> ParsecT s u m a
someWord    = (a -> Bool) -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
(a -> Bool) -> ParsecT s u m a
satisfy ((a -> Bool) -> ParsecT s u m a)
-> ([a] -> a -> Bool) -> [a] -> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> Bool) -> [a] -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([a] -> a -> Bool) -> ([a] -> [a]) -> [a] -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a b. (Enum a, Enum b) => a -> b
enum
noWord :: [a] -> ParsecT s u m a
noWord      = (a -> Bool) -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
(a -> Bool) -> ParsecT s u m a
satisfy ((a -> Bool) -> ParsecT s u m a)
-> ([a] -> a -> Bool) -> [a] -> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> Bool) -> [a] -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem ([a] -> a -> Bool) -> ([a] -> [a]) -> [a] -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a b. (Enum a, Enum b) => a -> b
enum

whitespace :: ParsecT s u m [a]
whitespace  = ParsecT s u m a -> ParsecT s u m [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {b} {u}.
(Stream s m a, Enum a, Enum b) =>
(b -> Bool) -> ParsecT s u m a
satisfyChar Char -> Bool
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 :: ParsecT s u m [a]
escapedChar             = (a -> a -> [a])
-> ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\a
x a
y -> [a
x, a
y]) (Char -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
a -> ParsecT s u m a
exactWord Char
'\\') ParsecT s u m a
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m a
anyWord
unescapedExcept :: [a] -> ParsecT s u m (m a)
unescapedExcept      [a]
ws = (a -> m a) -> ParsecT s u m a -> ParsecT s u m (m a)
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ParsecT s u m a
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
[a] -> ParsecT s u m a
noWord [a]
ws)
literalTextExcept :: [a] -> ParsecT s u m [a]
literalTextExcept    [a]
ws = ([[a]] -> [a]) -> ParsecT s u m [[a]] -> ParsecT s u m [a]
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ParsecT s u m [[a]] -> ParsecT s u m [a])
-> ParsecT s u m [[a]] -> ParsecT s u m [a]
forall a b. (a -> b) -> a -> b
$ ParsecT s u m [a] -> ParsecT s u m [[a]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m [a]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Eq a, Enum a) =>
ParsecT s u m [a]
escapedChar ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> ParsecT s u m [a]
forall {s} {m :: * -> *} {a} {a} {m :: * -> *} {u}.
(Stream s m a, Eq a, Enum a, Enum a, Monad m) =>
[a] -> ParsecT s u m (m a)
unescapedExcept [a]
ws)

property :: ParsecT s u m Property
property = (SourcePos -> [Word8] -> [[Word8]] -> Property)
-> ParsecT s u m SourcePos
-> ParsecT s u m [Word8]
-> ParsecT s u m [[Word8]]
-> ParsecT s u m Property
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (((String -> [[Word8]] -> Property)
-> ([Word8] -> String) -> [Word8] -> [[Word8]] -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
forall a b. (Enum a, Enum b) => a -> b
enum) ((String -> [[Word8]] -> Property)
 -> [Word8] -> [[Word8]] -> Property)
-> (SourcePos -> String -> [[Word8]] -> Property)
-> SourcePos
-> [Word8]
-> [[Word8]]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> String -> [[Word8]] -> Property
Property)
    (ParsecT s u m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition)
    (ParsecT s u m Word8 -> ParsecT s u m [Word8]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT s u m Word8
forall {s} {m :: * -> *} {a} {b} {u}.
(Stream s m a, Enum a, Enum b) =>
(b -> Bool) -> ParsecT s u m a
satisfyChar ((Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&) Char -> Bool
isUpper (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\128'))))
    (ParsecT s u m [Word8]
-> ParsecT s u m [Word8] -> ParsecT s u m [[Word8]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 (Char -> ParsecT s u m Word8
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
a -> ParsecT s u m a
exactWord Char
'[' ParsecT s u m Word8
-> ParsecT s u m [Word8] -> ParsecT s u m [Word8]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
[a] -> ParsecT s u m [a]
literalTextExcept String
"]" ParsecT s u m [Word8]
-> ParsecT s u m Word8 -> ParsecT s u m [Word8]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT s u m Word8
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
a -> ParsecT s u m a
exactWord Char
']') ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace)

node :: ParsecT s u m [Property]
node = do
    Char -> ParsecT s u m Word8
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
a -> ParsecT s u m a
exactWord Char
';'
    ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace
    ParsecT s u m Property
-> ParsecT s u m [Word8] -> ParsecT s u m [Property]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy ParsecT s u m Property
forall {s} {m :: * -> *} {u}.
Stream s m Word8 =>
ParsecT s u m Property
property ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace

gameTree :: ParsecT s u m (Tree [Property])
gameTree = do
    Char -> ParsecT s u m Word8
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
a -> ParsecT s u m a
exactWord Char
'('
    ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace
    ([Property]
node:[[Property]]
nodes) <- ParsecT s u m [Property]
-> ParsecT s u m [Word8] -> ParsecT s u m [[Property]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 ParsecT s u m [Property]
forall {s} {m :: * -> *} {u}.
Stream s m Word8 =>
ParsecT s u m [Property]
node     ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace
    [Tree [Property]]
trees        <- ParsecT s u m (Tree [Property])
-> ParsecT s u m [Word8] -> ParsecT s u m [Tree [Property]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy  ParsecT s u m (Tree [Property])
gameTree ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace
    Char -> ParsecT s u m Word8
forall {s} {m :: * -> *} {a} {a} {u}.
(Stream s m a, Eq a, Enum a, Enum a) =>
a -> ParsecT s u m a
exactWord Char
')'
    Tree [Property] -> ParsecT s u m (Tree [Property])
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Property] -> [Tree [Property]] -> Tree [Property]
forall a. a -> [Tree a] -> Tree a
Node [Property]
node (([Property] -> [Tree [Property]] -> [Tree [Property]])
-> [Tree [Property]] -> [[Property]] -> [Tree [Property]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Tree [Property] -> [Tree [Property]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree [Property] -> [Tree [Property]])
-> ([Tree [Property]] -> Tree [Property])
-> [Tree [Property]]
-> [Tree [Property]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([Tree [Property]] -> Tree [Property])
 -> [Tree [Property]] -> [Tree [Property]])
-> ([Property] -> [Tree [Property]] -> Tree [Property])
-> [Property]
-> [Tree [Property]]
-> [Tree [Property]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Property] -> [Tree [Property]] -> Tree [Property]
forall a. a -> [Tree a] -> Tree a
Node) [Tree [Property]]
trees [[Property]]
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 :: forall s (m :: * -> *) u.
Stream s m Word8 =>
ParsecT s u m [Tree [Property]]
collection = ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace ParsecT s u m [Word8]
-> ParsecT s u m [Tree [Property]]
-> ParsecT s u m [Tree [Property]]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m (Tree [Property])
-> ParsecT s u m [Word8] -> ParsecT s u m [Tree [Property]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 ParsecT s u m (Tree [Property])
forall {s} {m :: * -> *} {u}.
Stream s m Word8 =>
ParsecT s u m (Tree [Property])
gameTree ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace ParsecT s u m [Tree [Property]]
-> ParsecT s u m [Word8] -> ParsecT s u m [Tree [Property]]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m [Word8]
forall {s} {m :: * -> *} {a} {u}.
(Stream s m a, Enum a) =>
ParsecT s u m [a]
whitespace ParsecT s u m [Tree [Property]]
-> ParsecT s u m () -> ParsecT s u m [Tree [Property]]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof