Clean up Program parsers. #148

* Move into Language.CQL.Parser.Program.

* Simplify some of the stuff inside.

Author: epost

src/Language/CQL.hs

@@ -42,23 +42,23 @@ module Language.CQL where
 import           Control.Concurrent
 import           Control.DeepSeq
 import           Control.Exception
-import           Data.List              (nub)
-import qualified Data.Map.Strict        as Map
+import           Data.List                   (nub)
+import qualified Data.Map.Strict             as Map
 import           Data.Maybe
 import           Data.Typeable
-import           Language.CQL.Common    as C
+import           Language.CQL.Common         as C
 import           Language.CQL.Graph
-import           Language.CQL.Instance  as I
-import           Language.CQL.Mapping   as M
+import           Language.CQL.Instance       as I
+import           Language.CQL.Mapping        as M
 import           Language.CQL.Options
-import           Language.CQL.Parser    (parseCqlProgram)
-import           Language.CQL.Program   as P
-import           Language.CQL.Query     as Q
-import           Language.CQL.Schema    as S
-import           Language.CQL.Term      as Term
-import           Language.CQL.Transform as Tr
-import           Language.CQL.Typeside  as T
-import           Prelude                hiding (EQ, exp)
+import           Language.CQL.Parser.Program (parseProgram)
+import           Language.CQL.Program        as P
+import           Language.CQL.Query          as Q
+import           Language.CQL.Schema         as S
+import           Language.CQL.Term           as Term
+import           Language.CQL.Transform      as Tr
+import           Language.CQL.Typeside       as T
+import           Prelude                     hiding (EQ, exp)
 import           System.IO.Unsafe
 
 -- | Times out a computation after @i@ microseconds.
@@ -243,7 +243,7 @@ type Env = KindCtx TypesideEx SchemaEx InstanceEx MappingEx QueryEx TransformEx
 -- | Parse, typecheck, and evaluate the CQL program.
 runProg :: String -> Err (Prog, Types, Env)
 runProg srcText = do
-  progE  <- parseCqlProgram srcText
+  progE  <- parseProgram srcText
   opts   <- toOptions defaultOptions $ other progE
   o      <- findOrder progE
   typesE <- typecheckCqlProgram o progE newTypes

src/Language/CQL/Parser.hs src/Language/CQL/Parser/Program.hs

@@ -18,7 +18,8 @@ GNU Affero General Public License for more details.
 You should have received a copy of the GNU Affero General Public License
 along with this program.  If not, see <https://www.gnu.org/licenses/>.
 -}
-module Language.CQL.Parser where
+
+module Language.CQL.Parser.Program where
 
 import           Data.List
 import           Data.Map                       as Map hiding ((\\))
@@ -34,21 +35,21 @@ import           Language.CQL.Parser.Typeside   as T'
 import           Language.CQL.Program           as P
 import           Text.Megaparsec
 
-parseCqlProgram :: String -> Err Prog
-parseCqlProgram s = case runParser parseCqlProgram' "" s of
-  Left err -> Left $ "Parse error: " ++ parseErrorPretty err
-  Right (o, x) -> if length (fst $ unzip x) == length (nub $ fst $ unzip x)
-    then pure $ toProg o x
-    else Left $ "Duplicate definition: " ++ show (nub (fmap fst x \\ nub (fmap fst x)))
+parseProgram :: String -> Err Prog
+parseProgram s = case runParser parseProgram' "" s of
+  Left err           -> Left $ "Parse error: " ++ parseErrorPretty err
+  Right (opts, prog) -> if length (fst $ unzip prog) == length (nub $ fst $ unzip prog)
+    then Right $ toProg opts prog
+    else Left  $ "Duplicate definition: " ++ show (nub (fmap fst prog \\ nub (fmap fst prog)))
 
--- | Returns a list of config options and programs.
-parseCqlProgram' :: Parser ([(String, String)], [(String, Exp)])
-parseCqlProgram' =
+-- | Returns a list of config option key-value paired with programs.
+parseProgram' :: Parser ([(String, String)], [(String, Exp)])
+parseProgram' =
   between spaceConsumer eof configsAndProgs
   where
     configsAndProgs = do
       opts  <- optional (constant "options" *> many optionParser)
-      progs <- many parseSection
+      progs <- many parseExp
       return (fromMaybe [] opts, progs)
 
 toProg :: [(String, String)] -> [(String, Exp)] -> Prog
@@ -63,17 +64,17 @@ toProg opts ((v,e):p) = case e of
   where
     KindCtx t s i m q tr _ = toProg opts p
 
-parseSection :: Parser (String, Exp)
-parseSection =
-  section "typeside"  typesideExpParser ExpTy <|>
-  section "schema"    schemaExpParser   ExpS  <|>
-  section "instance"  instExpParser     ExpI  <|>
-  section "mapping"   mapExpParser      ExpM  <|>
-  section "transform" transExpParser    ExpT
+parseExp :: Parser (String, Exp)
+parseExp =
+  go "typeside"  typesideExpParser ExpTy <|>
+  go "schema"    schemaExpParser   ExpS  <|>
+  go "instance"  instExpParser     ExpI  <|>
+  go "mapping"   mapExpParser      ExpM  <|>
+  go "transform" transExpParser    ExpT
   where
-    section sectionKindName bodyParser ctor = do
-      _           <- constant sectionKindName
-      sectionName <- identifier
+    go expKindName bodyParser ctor = do
+      _           <- constant expKindName
+      expName <- identifier
       _           <- constant "="
       body        <- bodyParser
-      return (sectionName, ctor body)
+      return (expName, ctor body)