0 | -- SPDX-FileCopyrightText: 2021 The toml-idr developers
  1 | --
  2 | -- SPDX-License-Identifier: MPL-2.0
  3 |
  4 | module Language.TOML.Parser
  5 |
  6 | import Language.TOML.ConcreteSyntax
  7 | import Language.TOML.Tokens
  8 |
  9 | import Text.Parser
 10 | import Text.Token
 11 |
 12 | import Data.Bool
 13 | import Data.List
 14 | import Data.List1
 15 |
 16 | -- this code does need to be repeated
 17 | -- each clause has differentl laziness
 18 | private
 19 | fromEither : {c : _} -> Grammar state token c (Either String a) -> Grammar state token c a
 20 | fromEither {c = False} act = do
 21 |     xb <- bounds act
 22 |     the (Grammar _ _ False a) $
 23 |         case xb.val of
 24 |             Right x => pure x
 25 |             Left err => failLoc xb.bounds err
 26 | fromEither {c = True} act = do
 27 |     xb <- bounds act
 28 |     the (Grammar _ _ False a) $
 29 |         case xb.val of
 30 |             Right x => pure x
 31 |             Left err => failLoc xb.bounds err
 32 |
 33 | private
 34 | punct : Punctuation -> Grammar state TOMLToken True ()
 35 | punct p = match $ TTPunct p
 36 |
 37 | private
 38 | maybeNewlines : Grammar state TOMLToken False ()
 39 | maybeNewlines = do
 40 |     _ <- many (punct NewLine)
 41 |     pure ()
 42 |
 43 | private
 44 | newlines : Grammar state TOMLToken False ()
 45 | newlines = (some (punct NewLine) >>= \_ => pure ()) <|> eof
 46 |
 47 | private
 48 | allowNewlines : (p : Grammar state TOMLToken True a) -> Grammar state TOMLToken True a
 49 | allowNewlines p = maybeNewlines *> p <* maybeNewlines
 50 |
 51 | private
 52 | string : Grammar state TOMLToken True CValue
 53 | string = CVString <$> fromEither (terminal "string" getString)
 54 |
 55 | private
 56 | boolean : Grammar state TOMLToken True CValue
 57 | boolean = map CVBoolean $ match TTBoolean
 58 |
 59 | private
 60 | integer : Grammar state TOMLToken True CValue
 61 | integer = map CVInteger $ match TTInt
 62 |
 63 | private
 64 | float : Grammar state TOMLToken True CValue
 65 | float = map CVFloat $ match TTFloat
 66 |
 67 | private
 68 | bare : Grammar state TOMLToken True String
 69 | bare = match TTBare
 70 |
 71 | private
 72 | key : Grammar state TOMLToken True CKey
 73 | key = do
 74 |         first <- keyAtom
 75 |         rest <- many (punct Dot *> keyAtom)
 76 |         case rest of
 77 |             [] => pure $ CKAtom first
 78 |             rest => pure $ CKDotted (first:::rest)
 79 |     where
 80 |         keyAtom : Grammar state TOMLToken True CKeyAtom
 81 |         keyAtom = map CKBare bare
 82 |               <|> (map CKQuoted $ fromEither $ terminal "string key" getKeyString)
 83 |
 84 | mutual
 85 |     private
 86 |     value : Grammar state TOMLToken True CValue
 87 |     value = string
 88 |         <|> boolean
 89 |         <|> integer
 90 |         <|> float
 91 |         <|> array
 92 |         <|> inlineTable
 93 |     
 94 |     private
 95 |     array : Grammar state TOMLToken True CValue
 96 |     array = do
 97 |         punct (Square Open)
 98 |         commit
 99 |         vals <- sepBy (allowNewlines $ punct Comma) (allowNewlines value)
100 |         punct (Square Close)
101 |         pure $ CVArray vals
102 |     
103 |     private
104 |     inlineTable : Grammar state TOMLToken True CValue
105 |     inlineTable = do
106 |         punct (Curly Open)
107 |         commit
108 |         vals <- sepBy (punct Comma) $ do
109 |             k <- key
110 |             punct Equal
111 |             v <- value
112 |             pure (k, v)
113 |
114 |         punct (Curly Close)
115 |         pure $ CVInlineTable vals
116 |
117 | private
118 | keyValue : Grammar state TOMLToken True Item
119 | keyValue = do
120 |     k <- key
121 |     punct Equal
122 |     v <- value
123 |     newlines
124 |     pure $ IKeyValue k v
125 |
126 | private
127 | tableHeader : Grammar state TOMLToken True Item
128 | tableHeader = do
129 |     punct (Square Open)
130 |     k <- key
131 |     commit
132 |     punct (Square Close)
133 |     newlines
134 |     pure $ ITableHeader k
135 |
136 | private
137 | tableArrayHeader : Grammar state TOMLToken True Item
138 | tableArrayHeader = do
139 |     punct (Square Open)
140 |     punct (Square Open)
141 |     commit
142 |     k <- key
143 |     punct (Square Close)
144 |     punct (Square Close)
145 |     newlines
146 |     pure $ ITableArray k
147 |
148 | private
149 | item : Grammar state TOMLToken True Item
150 | item = keyValue
151 |    <|> tableHeader
152 |    <|> tableArrayHeader
153 |
154 | private
155 | items : Grammar state TOMLToken False (List Item)
156 | items = do
157 |     maybeNewlines 
158 |     is <- many item
159 |     maybeNewlines
160 |     eof
161 |     pure is
162 |
163 | export
164 | parseItems : List (WithBounds TOMLToken) -> Either (List String) (List Item)
165 | parseItems toks = case parse items $ filter (not . ignored) toks of
166 |     Right (its, []) => Right its
167 |     Right _ => Left ["unconsumed input"]
168 |     Left errs => Left . flip map (forget errs) $ \(Error msg bounds) =>
169 |         case bounds of
170 |             Just bounds =>
171 |                 "\{show bounds.startLine}:\{show bounds.startCol}--\{show bounds.endLine}:\{show bounds.endCol}: \{msg}"
172 |             Nothing => msg