-- boilerplate {{{
module Data.SGF.Parse.Util where

import Control.Arrow (Arrow (first, second, (&&&)))
import Control.Monad (liftM, liftM2, when, (>=>))
import Control.Monad.State (MonadState (get), MonadTrans (lift), StateT (StateT), gets, modify)
import qualified Control.Monad.Trans.Except as Either
import Control.Monad.Writer (MonadTrans (lift), MonadWriter (tell), WriterT)
import Data.Char (isDigit, isSpace, toLower)
import Data.Encoding (DynEncoding)
import Data.Function (on)
import Data.Ix (Ix (range))
import Data.List (groupBy, isPrefixOf, nub, partition, sortBy)
import Data.Map (Map (..), fromList, keys)
import Data.Maybe (fromJust, listToMaybe)
import Data.Ord (comparing)
import Data.SGF.Parse.Encodings (decodeWordStringExplicit)
import Data.SGF.Parse.Raw (Property (..), enum)
import Data.SGF.Types (Color (..), Emphasis (..), Judgment, Mark, PartialDate, Point)
import Data.Set (Set)
import Data.Tree (Tree (rootLabel))
import Data.Word (Word8)
import Text.Parsec (SourcePos)

-- }}}
-- new types {{{
-- Header {{{
data Header = Header
  { Header -> Integer
format :: Integer,
    Header -> DynEncoding
encoding :: DynEncoding
  }

-- }}}
-- Error {{{

data ErrorType
  = UnknownEncoding
  | AmbiguousEncoding
  | FormatUnsupported
  | GameUnsupported
  | OutOfBounds
  | BadlyFormattedValue
  | BadlyEncodedValue
  | ConcurrentMoveAndSetup
  | ConcurrentBlackAndWhiteMove
  | ConcurrentAnnotations
  | ExtraMoveAnnotations
  deriving (ErrorType -> ErrorType -> Bool
(ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool) -> Eq ErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorType -> ErrorType -> Bool
== :: ErrorType -> ErrorType -> Bool
$c/= :: ErrorType -> ErrorType -> Bool
/= :: ErrorType -> ErrorType -> Bool
Eq, Eq ErrorType
Eq ErrorType =>
(ErrorType -> ErrorType -> Ordering)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> ErrorType)
-> (ErrorType -> ErrorType -> ErrorType)
-> Ord ErrorType
ErrorType -> ErrorType -> Bool
ErrorType -> ErrorType -> Ordering
ErrorType -> ErrorType -> ErrorType
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 :: ErrorType -> ErrorType -> Ordering
compare :: ErrorType -> ErrorType -> Ordering
$c< :: ErrorType -> ErrorType -> Bool
< :: ErrorType -> ErrorType -> Bool
$c<= :: ErrorType -> ErrorType -> Bool
<= :: ErrorType -> ErrorType -> Bool
$c> :: ErrorType -> ErrorType -> Bool
> :: ErrorType -> ErrorType -> Bool
$c>= :: ErrorType -> ErrorType -> Bool
>= :: ErrorType -> ErrorType -> Bool
$cmax :: ErrorType -> ErrorType -> ErrorType
max :: ErrorType -> ErrorType -> ErrorType
$cmin :: ErrorType -> ErrorType -> ErrorType
min :: ErrorType -> ErrorType -> ErrorType
Ord, Int -> ErrorType -> ShowS
[ErrorType] -> ShowS
ErrorType -> String
(Int -> ErrorType -> ShowS)
-> (ErrorType -> String)
-> ([ErrorType] -> ShowS)
-> Show ErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorType -> ShowS
showsPrec :: Int -> ErrorType -> ShowS
$cshow :: ErrorType -> String
show :: ErrorType -> String
$cshowList :: [ErrorType] -> ShowS
showList :: [ErrorType] -> ShowS
Show, ReadPrec [ErrorType]
ReadPrec ErrorType
Int -> ReadS ErrorType
ReadS [ErrorType]
(Int -> ReadS ErrorType)
-> ReadS [ErrorType]
-> ReadPrec ErrorType
-> ReadPrec [ErrorType]
-> Read ErrorType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ErrorType
readsPrec :: Int -> ReadS ErrorType
$creadList :: ReadS [ErrorType]
readList :: ReadS [ErrorType]
$creadPrec :: ReadPrec ErrorType
readPrec :: ReadPrec ErrorType
$creadListPrec :: ReadPrec [ErrorType]
readListPrec :: ReadPrec [ErrorType]
Read, ErrorType
ErrorType -> ErrorType -> Bounded ErrorType
forall a. a -> a -> Bounded a
$cminBound :: ErrorType
minBound :: ErrorType
$cmaxBound :: ErrorType
maxBound :: ErrorType
Bounded, Int -> ErrorType
ErrorType -> Int
ErrorType -> [ErrorType]
ErrorType -> ErrorType
ErrorType -> ErrorType -> [ErrorType]
ErrorType -> ErrorType -> ErrorType -> [ErrorType]
(ErrorType -> ErrorType)
-> (ErrorType -> ErrorType)
-> (Int -> ErrorType)
-> (ErrorType -> Int)
-> (ErrorType -> [ErrorType])
-> (ErrorType -> ErrorType -> [ErrorType])
-> (ErrorType -> ErrorType -> [ErrorType])
-> (ErrorType -> ErrorType -> ErrorType -> [ErrorType])
-> Enum ErrorType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ErrorType -> ErrorType
succ :: ErrorType -> ErrorType
$cpred :: ErrorType -> ErrorType
pred :: ErrorType -> ErrorType
$ctoEnum :: Int -> ErrorType
toEnum :: Int -> ErrorType
$cfromEnum :: ErrorType -> Int
fromEnum :: ErrorType -> Int
$cenumFrom :: ErrorType -> [ErrorType]
enumFrom :: ErrorType -> [ErrorType]
$cenumFromThen :: ErrorType -> ErrorType -> [ErrorType]
enumFromThen :: ErrorType -> ErrorType -> [ErrorType]
$cenumFromTo :: ErrorType -> ErrorType -> [ErrorType]
enumFromTo :: ErrorType -> ErrorType -> [ErrorType]
$cenumFromThenTo :: ErrorType -> ErrorType -> ErrorType -> [ErrorType]
enumFromThenTo :: ErrorType -> ErrorType -> ErrorType -> [ErrorType]
Enum)

-- Errors signify unrecoverable errors.
data Error
  = KnownError {Error -> ErrorType
errorType :: ErrorType, Error -> SourcePos
errorPosition :: SourcePos}
  | UnknownError {Error -> Maybe String
errorDescription :: Maybe String}
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Eq Error
Eq Error =>
(Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
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 :: Error -> Error -> Ordering
compare :: Error -> Error -> Ordering
$c< :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
>= :: Error -> Error -> Bool
$cmax :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
min :: Error -> Error -> Error
Ord, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show)

die :: Error -> Translator a
dieWithPos :: ErrorType -> SourcePos -> Translator a
dieWith :: ErrorType -> Property -> Translator a
dieWithJust :: ErrorType -> Maybe Property -> Translator a
die :: forall a. Error -> Translator a
die = StateT State (Either Error) a
-> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => m a -> WriterT [Warning] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT State (Either Error) a
 -> WriterT [Warning] (StateT State (Either Error)) a)
-> (Error -> StateT State (Either Error) a)
-> Error
-> WriterT [Warning] (StateT State (Either Error)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State -> Either Error (a, State)) -> StateT State (Either Error) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((State -> Either Error (a, State))
 -> StateT State (Either Error) a)
-> (Error -> State -> Either Error (a, State))
-> Error
-> StateT State (Either Error) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (a, State) -> State -> Either Error (a, State)
forall a b. a -> b -> a
const (Either Error (a, State) -> State -> Either Error (a, State))
-> (Error -> Either Error (a, State))
-> Error
-> State
-> Either Error (a, State)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error (a, State)
forall a b. a -> Either a b
Left

dieWithPos :: forall a. ErrorType -> SourcePos -> Translator a
dieWithPos ErrorType
e = Error -> Translator a
forall a. Error -> Translator a
die (Error -> Translator a)
-> (SourcePos -> Error) -> SourcePos -> Translator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorType -> SourcePos -> Error
KnownError ErrorType
e

dieWith :: forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
e = ErrorType -> SourcePos -> Translator a
forall a. ErrorType -> SourcePos -> Translator a
dieWithPos ErrorType
e (SourcePos -> Translator a)
-> (Property -> SourcePos) -> Property -> Translator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> SourcePos
position

dieWithJust :: forall a. ErrorType -> Maybe Property -> Translator a
dieWithJust ErrorType
e = ErrorType -> Property -> Translator a
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
e (Property -> Translator a)
-> (Maybe Property -> Property) -> Maybe Property -> Translator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Property -> Property
forall a. HasCallStack => Maybe a -> a
fromJust

-- }}}
-- Warning {{{
-- by convention, a warning that does not end in a verb just "did the right thing" to correct the problem

-- |
-- Warnings signify recoverable errors.
data Warning
  = DuplicatePropertyOmitted Property
  | SquareSizeSpecifiedAsRectangle SourcePos
  | DanglingEscapeCharacterOmitted SourcePos
  | PropValueForNonePropertyOmitted Property
  | UnknownPropertyPreserved String
  | PointSpecifiedAsPointRange Property
  | DuplicatePointsOmitted Property [Point]
  | InvalidDatesClipped (Set PartialDate)
  | AnnotationWithNoMoveOmitted Property
  | ExtraGameInfoOmitted Property
  | NestedRootPropertyOmitted Property
  | MovelessAnnotationOmitted Property
  | DuplicateSetupOperationsOmitted [Point]
  | ExtraPositionalJudgmentOmitted (Judgment, Emphasis)
  | DuplicateMarkupOmitted (Mark, Point)
  | ExtraPropertyValuesOmitted Property
  | DuplicateLabelOmitted (Point, String)
  | UnknownNumberingIgnored Integer
  deriving (Warning -> Warning -> Bool
(Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool) -> Eq Warning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Warning -> Warning -> Bool
== :: Warning -> Warning -> Bool
$c/= :: Warning -> Warning -> Bool
/= :: Warning -> Warning -> Bool
Eq, Eq Warning
Eq Warning =>
(Warning -> Warning -> Ordering)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Warning)
-> (Warning -> Warning -> Warning)
-> Ord Warning
Warning -> Warning -> Bool
Warning -> Warning -> Ordering
Warning -> Warning -> Warning
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 :: Warning -> Warning -> Ordering
compare :: Warning -> Warning -> Ordering
$c< :: Warning -> Warning -> Bool
< :: Warning -> Warning -> Bool
$c<= :: Warning -> Warning -> Bool
<= :: Warning -> Warning -> Bool
$c> :: Warning -> Warning -> Bool
> :: Warning -> Warning -> Bool
$c>= :: Warning -> Warning -> Bool
>= :: Warning -> Warning -> Bool
$cmax :: Warning -> Warning -> Warning
max :: Warning -> Warning -> Warning
$cmin :: Warning -> Warning -> Warning
min :: Warning -> Warning -> Warning
Ord, Int -> Warning -> ShowS
[Warning] -> ShowS
Warning -> String
(Int -> Warning -> ShowS)
-> (Warning -> String) -> ([Warning] -> ShowS) -> Show Warning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Warning -> ShowS
showsPrec :: Int -> Warning -> ShowS
$cshow :: Warning -> String
show :: Warning -> String
$cshowList :: [Warning] -> ShowS
showList :: [Warning] -> ShowS
Show)

-- }}}
-- State, Translator a, PTranslator a {{{
type State = Tree [Property]

type Translator a = WriterT [Warning] (StateT State (Either Error)) a

type PTranslator a = Property -> Translator a

transMap, transMapMulti :: PTranslator a -> String -> Translator (Maybe a)
transMap :: forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator a
f = String -> Translator (Maybe Property)
consumeSingle (String -> Translator (Maybe Property))
-> (Maybe Property
    -> WriterT [Warning] (StateT State (Either Error)) (Maybe a))
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PTranslator a
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) (Maybe a)
forall a b. (a -> Translator b) -> Maybe a -> Translator (Maybe b)
transMap' PTranslator a
f
transMapMulti :: forall a. PTranslator a -> String -> Translator (Maybe a)
transMapMulti PTranslator a
f = String -> Translator (Maybe Property)
consume (String -> Translator (Maybe Property))
-> (Maybe Property
    -> WriterT [Warning] (StateT State (Either Error)) (Maybe a))
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PTranslator a
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) (Maybe a)
forall a b. (a -> Translator b) -> Maybe a -> Translator (Maybe b)
transMap' PTranslator a
f

transMap' :: (a -> Translator b) -> (Maybe a -> Translator (Maybe b))
transMap' :: forall a b. (a -> Translator b) -> Maybe a -> Translator (Maybe b)
transMap' a -> Translator b
f = Translator (Maybe b)
-> (a -> Translator (Maybe b)) -> Maybe a -> Translator (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> Translator (Maybe b)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing) ((b -> Maybe b) -> Translator b -> Translator (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Maybe b
forall a. a -> Maybe a
Just (Translator b -> Translator (Maybe b))
-> (a -> Translator b) -> a -> Translator (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Translator b
f)

transMapList :: PTranslator [a] -> String -> Translator [a]
transMapList :: forall a. PTranslator [a] -> String -> Translator [a]
transMapList PTranslator [a]
f = String -> Translator (Maybe Property)
consume (String -> Translator (Maybe Property))
-> (Maybe Property
    -> WriterT [Warning] (StateT State (Either Error)) [a])
-> String
-> WriterT [Warning] (StateT State (Either Error)) [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> WriterT [Warning] (StateT State (Either Error)) [a]
-> PTranslator [a]
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([a] -> WriterT [Warning] (StateT State (Either Error)) [a]
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []) PTranslator [a]
f

-- }}}
-- }}}
-- handy Translators {{{
-- helper functions {{{
duplicatesOn :: (Ord b) => (a -> b) -> [a] -> [a]
duplicatesOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
duplicatesOn a -> b
f =
  ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst
    ([(a, b)] -> [a]) -> ([a] -> [(a, b)]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, b)] -> [(a, b)]) -> [[(a, b)]] -> [(a, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [(a, b)] -> [(a, b)]
forall a. Int -> [a] -> [a]
drop Int
1)
    ([[(a, b)]] -> [(a, b)]) -> ([a] -> [[(a, b)]]) -> [a] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> ((a, b) -> b) -> (a, b) -> (a, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> b
forall a b. (a, b) -> b
snd)
    ([(a, b)] -> [[(a, b)]]) -> ([a] -> [(a, b)]) -> [a] -> [[(a, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> b
forall a b. (a, b) -> b
snd)
    ([(a, b)] -> [(a, b)]) -> ([a] -> [(a, b)]) -> [a] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, b)) -> [a] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a
forall a. a -> a
id (a -> a) -> (a -> b) -> a -> (a, b)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> b
f)

duplicateProperties :: State -> [Warning]
duplicateProperties :: State -> [Warning]
duplicateProperties = (Property -> Warning) -> [Property] -> [Warning]
forall a b. (a -> b) -> [a] -> [b]
map Property -> Warning
DuplicatePropertyOmitted ([Property] -> [Warning])
-> (State -> [Property]) -> State -> [Warning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Property -> String) -> [Property] -> [Property]
forall b a. Ord b => (a -> b) -> [a] -> [a]
duplicatesOn Property -> String
name ([Property] -> [Property])
-> (State -> [Property]) -> State -> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> [Property]
forall a. Tree a -> a
rootLabel

duplicates :: Translator ()
duplicates :: Translator ()
duplicates = WriterT [Warning] (StateT State (Either Error)) State
forall s (m :: * -> *). MonadState s m => m s
get WriterT [Warning] (StateT State (Either Error)) State
-> (State -> Translator ()) -> Translator ()
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Warning] -> Translator ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Warning] -> Translator ())
-> (State -> [Warning]) -> State -> Translator ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> [Warning]
duplicateProperties

readNumber :: String -> SourcePos -> Translator Integer
readNumber :: String -> SourcePos -> Translator Integer
readNumber String
"" SourcePos
_ = Integer -> Translator Integer
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
readNumber String
s SourcePos
pos
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
s = Integer -> Translator Integer
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Integer
forall a. Read a => String -> a
read String
s)
  | Bool
otherwise = ErrorType -> SourcePos -> Translator Integer
forall a. ErrorType -> SourcePos -> Translator a
dieWithPos ErrorType
BadlyFormattedValue SourcePos
pos

newline :: a -> (String -> a) -> (Char -> String -> a) -> String -> a
newline :: forall a.
a -> (String -> a) -> (Char -> String -> a) -> String -> a
newline a
empty String -> a
with Char -> String -> a
without String
xs = case String
xs of
  Char
'\r' : Char
'\n' : String
xs -> String -> a
with String
xs
  Char
'\n' : Char
'\r' : String
xs -> String -> a
with String
xs
  Char
'\r' : String
xs -> String -> a
with String
xs
  Char
'\n' : String
xs -> String -> a
with String
xs
  Char
x : String
xs -> Char -> String -> a
without Char
x String
xs
  [] -> a
empty

trim :: Char -> Char
trim :: Char -> Char
trim Char
x = if Char -> Bool
isSpace Char
x then Char
' ' else Char
x

descape :: Char -> SourcePos -> String -> Translator String
descape :: Char -> SourcePos -> String -> Translator String
descape Char
hard SourcePos
pos String
s = case String
s of
  (Char
'\\' : String
xs) -> Translator () -> ShowS -> String -> Translator String
forall {a}.
WriterT [Warning] (StateT State (Either Error)) a
-> ShowS -> String -> Translator String
newline' ([Warning] -> Translator ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [SourcePos -> Warning
DanglingEscapeCharacterOmitted SourcePos
pos]) ShowS
forall a. a -> a
id String
xs
  String
xs -> Translator () -> ShowS -> String -> Translator String
forall {a}.
WriterT [Warning] (StateT State (Either Error)) a
-> ShowS -> String -> Translator String
newline' (() -> Translator ()
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Char
hard Char -> ShowS
forall a. a -> [a] -> [a]
:) String
xs
  where
    newline' :: WriterT [Warning] (StateT State (Either Error)) a
-> ShowS -> String -> Translator String
newline' WriterT [Warning] (StateT State (Either Error)) a
warn ShowS
prefix = Translator String
-> (String -> Translator String)
-> (Char -> String -> Translator String)
-> String
-> Translator String
forall a.
a -> (String -> a) -> (Char -> String -> a) -> String -> a
newline (WriterT [Warning] (StateT State (Either Error)) a
warn WriterT [Warning] (StateT State (Either Error)) a
-> Translator String -> Translator String
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Translator String
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"") (ShowS -> Translator String -> Translator String
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
prefix (Translator String -> Translator String)
-> (String -> Translator String) -> String -> Translator String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> SourcePos -> String -> Translator String
descape Char
hard SourcePos
pos) (\Char
c -> ShowS -> Translator String -> Translator String
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Char
trim Char
c Char -> ShowS
forall a. a -> [a] -> [a]
:) (Translator String -> Translator String)
-> (String -> Translator String) -> String -> Translator String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> SourcePos -> String -> Translator String
descape Char
hard SourcePos
pos)

decodeAndDescape :: Char -> Header -> PTranslator String
decodeAndDescape :: Char -> Header -> PTranslator String
decodeAndDescape Char
hard (Header {encoding :: Header -> DynEncoding
encoding = DynEncoding
e}) (Property {values :: Property -> [[Word8]]
values = [Word8]
v : [[Word8]]
_, position :: Property -> SourcePos
position = SourcePos
pos}) =
  case DynEncoding -> [Word8] -> Either DecodingException String
forall e.
Encoding e =>
e -> [Word8] -> Either DecodingException String
decodeWordStringExplicit DynEncoding
e [Word8]
v of
    Left DecodingException
exception -> ErrorType -> SourcePos -> Translator String
forall a. ErrorType -> SourcePos -> Translator a
dieWithPos ErrorType
BadlyEncodedValue SourcePos
pos
    Right String
decoded -> Char -> SourcePos -> String -> Translator String
descape Char
hard SourcePos
pos String
decoded

splitColon :: [Word8] -> Maybe ([Word8], [Word8])
splitColons :: [[Word8]] -> Maybe ([[Word8]], [[Word8]])
splitColons :: [[Word8]] -> Maybe ([[Word8]], [[Word8]])
splitColons = ([([Word8], [Word8])] -> ([[Word8]], [[Word8]]))
-> Maybe [([Word8], [Word8])] -> Maybe ([[Word8]], [[Word8]])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([Word8], [Word8])] -> ([[Word8]], [[Word8]])
forall a b. [(a, b)] -> ([a], [b])
unzip (Maybe [([Word8], [Word8])] -> Maybe ([[Word8]], [[Word8]]))
-> ([[Word8]] -> Maybe [([Word8], [Word8])])
-> [[Word8]]
-> Maybe ([[Word8]], [[Word8]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8] -> Maybe ([Word8], [Word8]))
-> [[Word8]] -> Maybe [([Word8], [Word8])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Word8] -> Maybe ([Word8], [Word8])
splitColon
splitColon :: [Word8] -> Maybe ([Word8], [Word8])
splitColon [Word8]
xs
  | [Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
xs = Maybe ([Word8], [Word8])
forall a. Maybe a
Nothing
  | [Char -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum Char
':'] [Word8] -> [Word8] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Word8]
xs = ([Word8], [Word8]) -> Maybe ([Word8], [Word8])
forall a. a -> Maybe a
Just ([], Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
1 [Word8]
xs)
  | [Char -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum Char
'\\'] [Word8] -> [Word8] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Word8]
xs = Int -> Maybe ([Word8], [Word8])
continue Int
2
  | Bool
otherwise = Int -> Maybe ([Word8], [Word8])
continue Int
1
  where
    continue :: Int -> Maybe ([Word8], [Word8])
continue Int
n = (([Word8], [Word8]) -> ([Word8], [Word8]))
-> Maybe ([Word8], [Word8]) -> Maybe ([Word8], [Word8])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Word8] -> [Word8]) -> ([Word8], [Word8]) -> ([Word8], [Word8])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
n [Word8]
xs [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++)) ([Word8] -> Maybe ([Word8], [Word8])
splitColon (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
n [Word8]
xs))

warnAboutDuplicatePoints :: Property -> [Point] -> Translator [Point]
warnAboutDuplicatePoints :: Property -> [Point] -> Translator [Point]
warnAboutDuplicatePoints Property
p [Point]
ps =
  let ds :: [Point]
ds = (Point -> Point) -> [Point] -> [Point]
forall b a. Ord b => (a -> b) -> [a] -> [a]
duplicatesOn Point -> Point
forall a. a -> a
id [Point]
ps
   in do
        Bool -> Translator () -> Translator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Point] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Point]
ds) ([Warning] -> Translator ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Property -> [Point] -> Warning
DuplicatePointsOmitted Property
p [Point]
ds])
        [Point] -> Translator [Point]
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> [Point]
forall a. Eq a => [a] -> [a]
nub [Point]
ps)

checkPointList :: (PTranslator [Point] -> PTranslator [[Point]]) -> (PTranslator Point -> PTranslator [Point])
checkPointList :: (PTranslator [Point] -> PTranslator [[Point]])
-> PTranslator Point -> PTranslator [Point]
checkPointList PTranslator [Point] -> PTranslator [[Point]]
listType PTranslator Point
a Property
p = PTranslator [Point] -> PTranslator [[Point]]
listType (PTranslator Point -> PTranslator [Point]
mayBeCompoundPoint PTranslator Point
a) Property
p WriterT [Warning] (StateT State (Either Error)) [[Point]]
-> ([[Point]] -> Translator [Point]) -> Translator [Point]
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Property -> [Point] -> Translator [Point]
warnAboutDuplicatePoints Property
p ([Point] -> Translator [Point])
-> ([[Point]] -> [Point]) -> [[Point]] -> Translator [Point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Point]] -> [Point]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

-- }}}
-- low-level {{{
has :: String -> Translator Bool
has :: String -> Translator Bool
has String
s = (State -> Bool) -> Translator Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Property -> Bool) -> [Property] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (Property -> String) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> String
name) ([Property] -> Bool) -> (State -> [Property]) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> [Property]
forall a. Tree a -> a
rootLabel)

hasAny :: [String] -> Translator Bool
hasAny :: [String] -> Translator Bool
hasAny = ([Bool] -> Bool)
-> WriterT [Warning] (StateT State (Either Error)) [Bool]
-> Translator Bool
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (WriterT [Warning] (StateT State (Either Error)) [Bool]
 -> Translator Bool)
-> ([String]
    -> WriterT [Warning] (StateT State (Either Error)) [Bool])
-> [String]
-> Translator Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Translator Bool)
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> Translator Bool
has

consume :: String -> Translator (Maybe Property)
consume :: String -> Translator (Maybe Property)
consume String
s = do
  ([Property]
v, [Property]
rest) <- (State -> ([Property], [Property]))
-> WriterT
     [Warning] (StateT State (Either Error)) ([Property], [Property])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Property -> Bool) -> [Property] -> ([Property], [Property])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) (String -> Bool) -> (Property -> String) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> String
name) ([Property] -> ([Property], [Property]))
-> (State -> [Property]) -> State -> ([Property], [Property])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> [Property]
forall a. Tree a -> a
rootLabel)
  (State -> State) -> Translator ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\State
s -> State
s {rootLabel = rest})
  Maybe Property -> Translator (Maybe Property)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Property] -> Maybe Property
forall a. [a] -> Maybe a
listToMaybe [Property]
v)

consumeSingle :: String -> Translator (Maybe Property)
consumeSingle :: String -> Translator (Maybe Property)
consumeSingle String
s = do
  Maybe Property
maybeProperty <- String -> Translator (Maybe Property)
consume String
s
  case Maybe Property
maybeProperty of
    Just p :: Property
p@(Property {values :: Property -> [[Word8]]
values = ([Word8]
v : [Word8]
_ : [[Word8]]
_)}) -> do
      [Warning] -> Translator ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Property -> Warning
ExtraPropertyValuesOmitted Property
p]
      Maybe Property -> Translator (Maybe Property)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> Maybe Property
forall a. a -> Maybe a
Just Property
p {values = [v]})
    Maybe Property
_ -> Maybe Property -> Translator (Maybe Property)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Property
maybeProperty

unknownProperties :: Translator (Map String [[Word8]])
unknownProperties :: Translator (Map String [[Word8]])
unknownProperties = do
  Map String [[Word8]]
m <- (State -> Map String [[Word8]])
-> Translator (Map String [[Word8]])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([(String, [[Word8]])] -> Map String [[Word8]]
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(String, [[Word8]])] -> Map String [[Word8]])
-> (State -> [(String, [[Word8]])])
-> State
-> Map String [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Property -> (String, [[Word8]]))
-> [Property] -> [(String, [[Word8]])]
forall a b. (a -> b) -> [a] -> [b]
map (Property -> String
name (Property -> String)
-> (Property -> [[Word8]]) -> Property -> (String, [[Word8]])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Property -> [[Word8]]
values) ([Property] -> [(String, [[Word8]])])
-> (State -> [Property]) -> State -> [(String, [[Word8]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> [Property]
forall a. Tree a -> a
rootLabel)
  [Warning] -> Translator ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String -> Warning
UnknownPropertyPreserved String
name | String
name <- Map String [[Word8]] -> [String]
forall k a. Map k a -> [k]
keys Map String [[Word8]]
m]
  Map String [[Word8]] -> Translator (Map String [[Word8]])
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map String [[Word8]]
m

-- }}}
-- PTranslators and combinators {{{
number :: PTranslator Integer
number :: PTranslator Integer
number p :: Property
p@(Property {values :: Property -> [[Word8]]
values = [Word8]
v : [[Word8]]
_})
  | Char -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum Char
'.' Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
v = ErrorType -> PTranslator Integer
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
BadlyFormattedValue Property
p
  | Bool
otherwise = (Rational -> Integer)
-> WriterT [Warning] (StateT State (Either Error)) Rational
-> Translator Integer
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (PTranslator Rational
real Property
p)

real :: PTranslator Rational
real :: PTranslator Rational
real (Property {values :: Property -> [[Word8]]
values = [Word8]
v : [[Word8]]
_, position :: Property -> SourcePos
position = SourcePos
pos})
  | [Char -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum Char
'+'] [Word8] -> [Word8] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Word8]
v = Int -> WriterT [Warning] (StateT State (Either Error)) Rational
forall {b}.
Fractional b =>
Int -> WriterT [Warning] (StateT State (Either Error)) b
result Int
1
  | [Char -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum Char
'-'] [Word8] -> [Word8] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Word8]
v = (Rational -> Rational)
-> WriterT [Warning] (StateT State (Either Error)) Rational
-> WriterT [Warning] (StateT State (Either Error)) Rational
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Rational
forall a. Num a => a -> a
negate (Int -> WriterT [Warning] (StateT State (Either Error)) Rational
forall {b}.
Fractional b =>
Int -> WriterT [Warning] (StateT State (Either Error)) b
result Int
1)
  | Bool
otherwise = Int -> WriterT [Warning] (StateT State (Either Error)) Rational
forall {b}.
Fractional b =>
Int -> WriterT [Warning] (StateT State (Either Error)) b
result Int
0
  where
    split :: Int -> (String, String)
split Int
i = ShowS -> (String, String) -> (String, String)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1) ((String, String) -> (String, String))
-> ([Word8] -> (String, String)) -> [Word8] -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (String -> (String, String))
-> ([Word8] -> String) -> [Word8] -> (String, String)
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 ([Word8] -> String) -> ([Word8] -> [Word8]) -> [Word8] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
i ([Word8] -> (String, String)) -> [Word8] -> (String, String)
forall a b. (a -> b) -> a -> b
$ [Word8]
v
    result :: Int -> WriterT [Warning] (StateT State (Either Error)) b
result Int
i =
      let (String
n, String
d) = Int -> (String, String)
split Int
i
       in do
            Integer
whole <- String -> SourcePos -> Translator Integer
readNumber String
n SourcePos
pos
            Integer
fract <- String -> SourcePos -> Translator Integer
readNumber String
d SourcePos
pos
            b -> WriterT [Warning] (StateT State (Either Error)) b
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
whole b -> b -> b
forall a. Num a => a -> a -> a
+ Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
fract b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
10 b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
d)

simple :: Header -> PTranslator String
text :: Header -> PTranslator String
simple :: Header -> PTranslator String
simple = Char -> Header -> PTranslator String
decodeAndDescape Char
' '

text :: Header -> PTranslator String
text = Char -> Header -> PTranslator String
decodeAndDescape Char
'\n'

none :: PTranslator ()
none :: PTranslator ()
none (Property {values :: Property -> [[Word8]]
values = [[]]}) = () -> Translator ()
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
none Property
p = [Warning] -> Translator ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Property -> Warning
PropValueForNonePropertyOmitted Property
p]

choice :: [([Word8], a)] -> PTranslator a
choice :: forall a. [([Word8], a)] -> PTranslator a
choice [([Word8], a)]
vs p :: Property
p@(Property {values :: Property -> [[Word8]]
values = []}) = ErrorType -> Property -> Translator a
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
BadlyFormattedValue Property
p -- can't happen
choice [([Word8], a)]
vs p :: Property
p@(Property {values :: Property -> [[Word8]]
values = [Word8]
v : [[Word8]]
_}) = Translator a -> (a -> Translator a) -> Maybe a -> Translator a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ErrorType -> Property -> Translator a
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
BadlyFormattedValue Property
p) a -> Translator a
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word8] -> [([Word8], a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Word8]
v [([Word8], a)]
vs)

choice' :: [(String, a)] -> PTranslator a
choice' :: forall a. [(String, a)] -> PTranslator a
choice' [(String, a)]
vs = [([Word8], a)] -> PTranslator a
forall a. [([Word8], a)] -> PTranslator a
choice [((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum String
k, a
v) | (String
k', a
v) <- [(String, a)]
vs, String
k <- [String
k', (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
k']]

double :: PTranslator Emphasis
color :: PTranslator Color
double :: PTranslator Emphasis
double = [(String, Emphasis)] -> PTranslator Emphasis
forall a. [(String, a)] -> PTranslator a
choice' [(String
"1", Emphasis
Normal), (String
"2", Emphasis
Strong)]

color :: PTranslator Color
color = [(String, Color)] -> PTranslator Color
forall a. [(String, a)] -> PTranslator a
choice' [(String
"B", Color
Black), (String
"W", Color
White)]

compose :: PTranslator a -> PTranslator b -> PTranslator (a, b)
compose :: forall a b. PTranslator a -> PTranslator b -> PTranslator (a, b)
compose PTranslator a
a PTranslator b
b p :: Property
p@(Property {values :: Property -> [[Word8]]
values = [[Word8]]
vs}) = case [[Word8]] -> Maybe ([[Word8]], [[Word8]])
splitColons [[Word8]]
vs of
  Maybe ([[Word8]], [[Word8]])
Nothing -> ErrorType -> Property -> Translator (a, b)
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
BadlyFormattedValue Property
p
  Just ([[Word8]]
as, [[Word8]]
bs) -> (a -> b -> (a, b))
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
-> Translator (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (PTranslator a
a Property
p {values = as}) (PTranslator b
b Property
p {values = bs})

listOf :: PTranslator a -> PTranslator [a]
listOf :: forall a. PTranslator a -> PTranslator [a]
listOf PTranslator a
a p :: Property
p@(Property {values :: Property -> [[Word8]]
values = [[Word8]]
vs}) = PTranslator a
-> [Property]
-> WriterT [Warning] (StateT State (Either Error)) [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PTranslator a
a [Property
p {values = [v]} | [Word8]
v <- [[Word8]]
vs]

elistOf :: PTranslator a -> PTranslator [a]
elistOf :: forall a. PTranslator a -> PTranslator [a]
elistOf PTranslator a
_ (Property {values :: Property -> [[Word8]]
values = [[]]}) = [a] -> WriterT [Warning] (StateT State (Either Error)) [a]
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
elistOf PTranslator a
a Property
p = PTranslator a -> PTranslator [a]
forall a. PTranslator a -> PTranslator [a]
listOf PTranslator a
a Property
p

mayBeCompoundPoint, listOfPoint, elistOfPoint :: PTranslator Point -> PTranslator [Point]
mayBeCompoundPoint :: PTranslator Point -> PTranslator [Point]
mayBeCompoundPoint PTranslator Point
a p :: Property
p@(Property {values :: Property -> [[Word8]]
values = [Word8]
v : [[Word8]]
_}) = case [Word8] -> Maybe ([Word8], [Word8])
splitColon [Word8]
v of
  Maybe ([Word8], [Word8])
Nothing -> Point -> [Point]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> [Point])
-> WriterT [Warning] (StateT State (Either Error)) Point
-> Translator [Point]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PTranslator Point
a Property
p
  Just {} -> do
    (Point, Point)
pointRange <- PTranslator Point
-> PTranslator Point -> PTranslator (Point, Point)
forall a b. PTranslator a -> PTranslator b -> PTranslator (a, b)
compose PTranslator Point
a PTranslator Point
a Property
p {values = [v]}
    Bool -> Translator () -> Translator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Point -> Point -> Bool) -> (Point, Point) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Point, Point)
pointRange) ([Warning] -> Translator ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Property -> Warning
PointSpecifiedAsPointRange Property
p])
    [Point] -> Translator [Point]
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Point, Point) -> [Point]
forall a. Ix a => (a, a) -> [a]
range (Point, Point)
pointRange)
listOfPoint :: PTranslator Point -> PTranslator [Point]
listOfPoint = (PTranslator [Point] -> PTranslator [[Point]])
-> PTranslator Point -> PTranslator [Point]
checkPointList PTranslator [Point] -> PTranslator [[Point]]
forall a. PTranslator a -> PTranslator [a]
listOf
elistOfPoint :: PTranslator Point -> PTranslator [Point]
elistOfPoint = (PTranslator [Point] -> PTranslator [[Point]])
-> PTranslator Point -> PTranslator [Point]
checkPointList PTranslator [Point] -> PTranslator [[Point]]
forall a. PTranslator a -> PTranslator [a]
elistOf

-- }}}
-- }}}