1{-|
2Module     : Data.Ini.Config.Raw
3Copyright  : (c) Getty Ritter, 2017
4License    : BSD
5Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
6Stability  : experimental
7
8__Warning!__ This module is subject to change in the future, and therefore should
9not be relied upon to have a consistent API.
10
11-}
12module Data.Ini.Config.Raw
13( -- * INI types
14  RawIni(..)
15, IniSection(..)
16, IniValue(..)
17, BlankLine(..)
18, NormalizedText(..)
19, normalize
20  -- * serializing and deserializing
21, parseRawIni
22, printRawIni
23  -- * inspection
24, lookupInSection
25, lookupSection
26, lookupValue
27) where
28
29import           Control.Monad (void)
30import qualified Data.Foldable as F
31import           Data.Monoid ((<>))
32import           Data.Sequence (Seq)
33import qualified Data.Sequence as Seq
34import           Data.Text (Text)
35import qualified Data.Text as T
36import qualified Data.Text.Lazy as LazyText
37import qualified Data.Text.Lazy.Builder as Builder
38import           Data.Void (Void)
39import           Text.Megaparsec
40import           Text.Megaparsec.Char
41
42type Parser = Parsec Void Text
43
44-- | The 'NormalizedText' type is an abstract representation of text
45-- which has had leading and trailing whitespace removed and been
46-- normalized to lower-case, but from which we can still extract the
47-- original, non-normalized version. This acts like the normalized
48-- text for the purposes of 'Eq' and 'Ord' operations, so
49--
50-- @
51--   'normalize' "  x  " == 'normalize' \"X\"
52-- @
53--
54-- This type is used to store section and key names in the
55data NormalizedText = NormalizedText
56  { actualText     :: Text
57  , normalizedText :: Text
58  } deriving (Show)
59
60-- | The constructor function to build a 'NormalizedText' value. You
61-- probably shouldn't be using this module directly, but if for some
62-- reason you are using it, then you should be using this function to
63-- create 'NormalizedText' values.
64normalize :: Text -> NormalizedText
65normalize t = NormalizedText t (T.toLower (T.strip t))
66
67instance Eq NormalizedText where
68  NormalizedText _ x == NormalizedText _ y =
69    x == y
70
71instance Ord NormalizedText where
72  NormalizedText _ x `compare` NormalizedText _ y =
73    x `compare` y
74
75-- | An 'Ini' value is a mapping from section names to
76--   'IniSection' values. The section names in this mapping are
77--   normalized to lower-case and stripped of whitespace. This
78--   sequence retains the ordering of the original source file.
79newtype RawIni = RawIni
80  { fromRawIni :: Seq (NormalizedText, IniSection)
81  } deriving (Eq, Show)
82
83-- | An 'IniSection' consists of a name, a mapping of key-value pairs,
84--   and metadata about where the section starts and ends in the
85--   file. The section names found in 'isName' are __not__ normalized
86--   to lower-case or stripped of whitespace, and thus should appear
87--   exactly as they appear in the original source file.
88data IniSection = IniSection
89  { isName      :: Text
90                   -- ^ The name of the section, as it appears in the
91                   -- original INI source
92  , isVals      :: Seq (NormalizedText, IniValue)
93                   -- ^ The key-value mapping within that section. Key
94                   -- names here are normalized to lower-case and
95                   -- stripped of whitespace. This sequence retains
96                   -- the ordering of the original source file.
97  , isStartLine :: Int
98                   -- ^ The line on which the section begins. This
99                   -- field is ignored when serializing, and is only
100                   -- used for error messages produced when parsing
101                   -- and deserializing an INI structure.
102  , isEndLine   :: Int
103                   -- ^ The line on which the section ends. This field
104                   -- is ignored when serializing, and is only used
105                   -- for error messages produced when parsing and
106                   -- deserializing an INI structure.
107  , isComments  :: Seq BlankLine
108                   -- ^ The blank lines and comments that appear prior
109                   -- to the section head declaration, retained for
110                   -- pretty-printing identical INI files.
111  } deriving (Eq, Show)
112
113-- | An 'IniValue' represents a key-value mapping, and also stores the
114--   line number where it appears. The key names and values found in
115--   'vName' and 'vValue' respectively are _not_ normalized to
116--   lower-case or stripped of whitespace, and thus should appear
117--   exactly as they appear in the original source file.
118data IniValue = IniValue
119  { vLineNo       :: Int
120                     -- ^ The line on which the key/value mapping
121                     -- appears. This field is ignored when
122                     -- serializing, and is only used for error
123                     -- messages produced when parsing and
124                     -- deserializing an INI structure.
125  , vName         :: Text
126                     -- ^ The name of the key, as it appears in the INI source.
127  , vValue        :: Text
128                     -- ^ The value of the key
129  , vComments     :: Seq BlankLine
130  , vCommentedOut :: Bool
131    -- ^ Right now, this will never show up in a parsed INI file, but
132    --   it's used when emitting a default INI file: it causes the
133    --   key-value line to include a leading comment as well.
134  , vDelimiter    :: Char
135  } deriving (Eq, Show)
136
137-- | We want to keep track of the whitespace/comments in between KV
138--   lines, so this allows us to track those lines in a reproducible
139--   way.
140data BlankLine
141  = CommentLine Char Text
142  | BlankLine
143    deriving (Eq, Show)
144
145-- | Parse a 'Text' value into an 'Ini' value, retaining a maximal
146-- amount of structure as needed to reconstruct the original INI file.
147parseRawIni :: Text -> Either String RawIni
148parseRawIni t = case runParser pIni "ini file" t of
149  Left err -> Left (errorBundlePretty err)
150  Right v  -> Right v
151
152pIni :: Parser RawIni
153pIni = do
154  leading <- sBlanks
155  pSections leading Seq.empty
156
157sBlanks :: Parser (Seq BlankLine)
158sBlanks = Seq.fromList <$> many ((BlankLine <$ void eol) <|> sComment)
159
160sComment :: Parser BlankLine
161sComment = do
162  c <- oneOf ";#"
163  txt <- T.pack `fmap` manyTill anySingle eol
164  return (CommentLine c txt)
165
166pSections :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
167pSections leading prevs =
168  pSection leading prevs <|> (RawIni prevs <$ void eof)
169
170pSection :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
171pSection leading prevs = do
172  start <- getCurrentLine
173  void (char '[')
174  name <- T.pack `fmap` some (noneOf "[]")
175  void (char ']')
176  void eol
177  comments <- sBlanks
178  pPairs (T.strip name) start leading prevs comments Seq.empty
179
180pPairs :: Text
181       -> Int
182       -> Seq BlankLine
183       -> Seq (NormalizedText, IniSection)
184       -> Seq BlankLine
185       -> Seq (NormalizedText, IniValue)
186       -> Parser RawIni
187pPairs name start leading prevs comments pairs = newPair <|> finishedSection
188  where
189    newPair = do
190      (n, pair) <- pPair comments
191      rs <- sBlanks
192      pPairs name start leading prevs rs (pairs Seq.|> (n, pair))
193    finishedSection = do
194      end <- getCurrentLine
195      let newSection = IniSection
196            { isName      = name
197            , isVals      = pairs
198            , isStartLine = start
199            , isEndLine   = end
200            , isComments  = leading
201            }
202      pSections comments (prevs Seq.|> (normalize name, newSection))
203
204pPair :: Seq BlankLine -> Parser (NormalizedText, IniValue)
205pPair leading = do
206  pos <- getCurrentLine
207  key <- T.pack `fmap` some (noneOf "[]=:")
208  delim <- oneOf ":="
209  val <- T.pack `fmap` manyTill anySingle eol
210  return ( normalize key
211         , IniValue
212             { vLineNo       = pos
213             , vName         = key
214             , vValue        = val
215             , vComments     = leading
216             , vCommentedOut = False
217             , vDelimiter    = delim
218             } )
219
220getCurrentLine :: Parser Int
221getCurrentLine = (fromIntegral . unPos . sourceLine) `fmap` getSourcePos
222
223
224-- | Serialize an INI file to text, complete with any comments which
225-- appear in the INI structure, and retaining the aesthetic details
226-- which are present in the INI file.
227printRawIni :: RawIni -> Text
228printRawIni = LazyText.toStrict . Builder.toLazyText . F.foldMap build . fromRawIni
229  where
230    build (_, ini) =
231      F.foldMap buildComment (isComments ini) <>
232      Builder.singleton '[' <>
233      Builder.fromText (isName ini) <>
234      Builder.fromString "]\n" <>
235      F.foldMap buildKV (isVals ini)
236    buildComment BlankLine = Builder.singleton '\n'
237    buildComment (CommentLine c txt) =
238      Builder.singleton c <> Builder.fromText txt <> Builder.singleton '\n'
239    buildKV (_, val) =
240      F.foldMap buildComment (vComments val) <>
241      (if vCommentedOut val then Builder.fromString "# " else mempty) <>
242      Builder.fromText (vName val) <>
243      Builder.singleton (vDelimiter val) <>
244      Builder.fromText (vValue val) <>
245      Builder.singleton '\n'
246
247-- | Look up an Ini value by section name and key. Returns the sequence
248-- of matches.
249lookupInSection :: Text
250                -- ^ The section name. Will be normalized prior to
251                -- comparison.
252                -> Text
253                -- ^ The key. Will be normalized prior to comparison.
254                -> RawIni
255                -- ^ The Ini to search.
256                -> Seq.Seq Text
257lookupInSection sec opt ini =
258    vValue <$> (F.asum (lookupValue opt <$> lookupSection sec ini))
259
260-- | Look up an Ini section by name. Returns a sequence of all matching
261-- section records.
262lookupSection :: Text
263              -- ^ The section name. Will be normalized prior to
264              -- comparison.
265              -> RawIni
266              -- ^ The Ini to search.
267              -> Seq.Seq IniSection
268lookupSection name ini =
269    snd <$> (Seq.filter ((== normalize name) . fst) $ fromRawIni ini)
270
271-- | Look up an Ini key's value in a given section by the key. Returns
272-- the sequence of matches.
273lookupValue :: Text
274            -- ^ The key. Will be normalized prior to comparison.
275            -> IniSection
276            -- ^ The section to search.
277            -> Seq.Seq IniValue
278lookupValue name section =
279    snd <$> Seq.filter ((== normalize name) . fst) (isVals section)
280