jcc/Hcompta/Format/JCC/Common/Read.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 module Hcompta.Format.JCC.Common.Read where
   3
   4 import           Control.Applicative ((<$>))
   5 import           Control.Monad (void)
   6 import           Data.Bool
   7 import           Data.Char (Char)
   8 import qualified Data.Char
   9 import           Data.String (fromString)
  10 import           Data.Text (Text)
  11 import           Data.Typeable ()
  12 import           Prelude (($))
  13 import qualified Text.Parsec as R hiding
  14                   ( char
  15                   , anyChar
  16                   , crlf
  17                   , newline
  18                   , noneOf
  19                   , oneOf
  20                   , satisfy
  21                   , space
  22                   , spaces
  23                   , string
  24                   , tab
  25                   )
  26 import           Text.Parsec (Stream, ParsecT, (<|>), (<?>))
  27
  28 import qualified Hcompta.Lib.Parsec as R
  29
  30 -- * Read characters
  31
  32 is_space :: Char -> Bool
  33 is_space c =
  34         case Data.Char.generalCategory c of
  35          Data.Char.Space -> True
  36          _ -> False
  37 space :: Stream s m Char => ParsecT s u m Char
  38 space = R.satisfy is_space
  39
  40 is_char :: Char -> Bool
  41 is_char c =
  42         case Data.Char.generalCategory c of
  43          Data.Char.UppercaseLetter      -> True
  44          Data.Char.LowercaseLetter      -> True
  45          Data.Char.TitlecaseLetter      -> True
  46          Data.Char.ModifierLetter       -> True
  47          Data.Char.OtherLetter          -> True
  48
  49          Data.Char.NonSpacingMark       -> True
  50          Data.Char.SpacingCombiningMark -> True
  51          Data.Char.EnclosingMark        -> True
  52
  53          Data.Char.DecimalNumber        -> True
  54          Data.Char.LetterNumber         -> True
  55          Data.Char.OtherNumber          -> True
  56
  57          Data.Char.ConnectorPunctuation -> True
  58          Data.Char.DashPunctuation      -> True
  59          Data.Char.OpenPunctuation      -> True
  60          Data.Char.ClosePunctuation     -> True
  61          Data.Char.InitialQuote         -> True
  62          Data.Char.FinalQuote           -> True
  63          Data.Char.OtherPunctuation     -> True
  64
  65          Data.Char.MathSymbol           -> True
  66          Data.Char.CurrencySymbol       -> True
  67          Data.Char.ModifierSymbol       -> True
  68          Data.Char.OtherSymbol          -> True
  69
  70          Data.Char.Space                -> False
  71          Data.Char.LineSeparator        -> False
  72          Data.Char.ParagraphSeparator   -> False
  73          Data.Char.Control              -> False
  74          Data.Char.Format               -> False
  75          Data.Char.Surrogate            -> False
  76          Data.Char.PrivateUse           -> False
  77          Data.Char.NotAssigned          -> False
  78 char :: Stream s m Char => ParsecT s u m Char
  79 char = R.satisfy is_char
  80
  81 is_char_active :: Char -> Bool
  82 is_char_active c =
  83         case c of
  84          '/' -> True
  85          '\\' -> True
  86          '!' -> True
  87          '?' -> True
  88          '\'' -> True
  89          '"' -> True
  90          '&' -> True
  91          '|' -> True
  92          '-' -> True
  93          '+' -> True
  94          '.' -> True
  95          ':' -> True
  96          '=' -> True
  97          '<' -> True
  98          '>' -> True
  99          '@' -> True
 100          '#' -> True
 101          '(' -> True
 102          ')' -> True
 103          '[' -> True
 104          ']' -> True
 105          '{' -> True
 106          '}' -> True
 107          '~' -> True
 108          '*' -> True
 109          '^' -> True
 110          ';' -> True
 111          ',' -> True
 112          _  -> False
 113 char_active :: Stream s m Char => ParsecT s u m Char
 114 char_active = R.satisfy is_char_active
 115
 116 is_char_passive :: Char -> Bool
 117 is_char_passive c =
 118         is_char c && not (is_char_active c)
 119 char_passive :: Stream s m Char => ParsecT s u m Char
 120 char_passive = R.satisfy is_char_passive
 121
 122 word :: Stream s m Char => ParsecT s u m Text
 123 word = fromString <$> R.many char_passive
 124
 125 words :: Stream s m Char => ParsecT s u m [Text]
 126 words = R.many_separated word space
 127
 128 name :: Stream s m Char => ParsecT s u m Text
 129 name = fromString <$> R.many1 char_passive
 130
 131 tabulation :: Stream s m Char => ParsecT s u m Char
 132 tabulation = R.char '\t'
 133
 134 hspace :: Stream s m Char => ParsecT s u m Char
 135 hspace = R.char ' '
 136
 137 hspaces :: Stream s m Char => ParsecT s u m ()
 138 hspaces = void $ R.many hspace
 139
 140 hspaces1 :: Stream s m Char => ParsecT s u m ()
 141 hspaces1 = void $ R.many1 hspace
 142
 143 eol :: Stream s m Char => ParsecT s u m ()
 144 eol = ((R.<|>) (void $ R.char '\n') (void $ R.try $ R.string "\r\n")) <?> "eol"
 145
 146 line :: Stream s m Char => ParsecT s u m Text
 147 line =
 148         fromString <$> R.manyTill char (R.lookAhead eol <|> R.eof)
 149         -- R.many (R.notFollowedBy eol >> char)