]>
Commit | Line | Data |
---|---|---|
a9d77a20 FM |
1 | {-# LANGUAGE FlexibleContexts #-} |
2 | {-# LANGUAGE TupleSections #-} | |
3 | ||
4 | module Text.Edifact.Scaffolder.Commons.Parsing | |
5 | ( -- * | |
6 | maybeParse | |
7 | , skipBeginning | |
8 | , single | |
9 | , silent | |
10 | -- * | |
11 | , listElements | |
12 | -- * | |
13 | , presenceParser | |
14 | , stringToPresenceParser | |
15 | -- * | |
16 | , messageCodeParser | |
17 | -- * | |
18 | , scanDependencies | |
19 | , scan | |
20 | , scanUntil | |
21 | ) where | |
22 | ||
23 | import Text.Edifact.Scaffolder.Commons.Logging (say) | |
24 | import Text.Edifact.Scaffolder.Commons.Types | |
25 | ||
26 | import Control.Monad.IO.Class (liftIO) | |
27 | import Control.Monad.Identity (Identity) | |
28 | import Control.Monad.Reader (asks, local) | |
29 | import Data.Bifunctor (first) | |
30 | import Data.List (sort) | |
31 | import Data.List.NonEmpty (NonEmpty, nonEmpty) | |
32 | import Data.Maybe (catMaybes) | |
33 | import Data.String (fromString) | |
34 | import Data.Text (Text) | |
35 | import Formatting as F (shown) | |
36 | import System.Directory (listDirectory) | |
37 | import System.FilePath ((</>)) | |
38 | import Text.Parsec (Parsec, SourceName, | |
39 | Stream, anyChar, char, | |
40 | choice, count, | |
41 | endOfLine, eof, | |
42 | lookAhead, many, | |
43 | many1, manyTill, | |
44 | oneOf, optionMaybe, | |
45 | runParser, string, | |
46 | try, upper, (<?>)) | |
47 | ||
48 | maybeParse :: (Show a, Stream s Identity t, Monoid u) => SourceName -> Parsec s u a -> s -> Scaffolding (Maybe a) | |
49 | maybeParse source parser input = | |
50 | let interpretParsingResult (Right v) _ = pure (Just v) | |
51 | interpretParsingResult e True = Nothing <$ say shown e | |
52 | interpretParsingResult _ False = pure Nothing | |
53 | shouldDebug = asks debugParsing | |
54 | in shouldDebug >>= interpretParsingResult (runParser parser mempty source input) | |
55 | ||
56 | -- | Disable parsing error logging locally | |
57 | silent :: Scaffolding a -> Scaffolding a | |
58 | silent = local disableDebugging | |
59 | ||
60 | -- | Let you traverse a directory and filter files matching a parser. | |
61 | -- The filename is then paired with the matched value | |
62 | listElements :: (Show elt, Ord elt) => FilePath -> Parsec String () elt -> Scaffolding [(FilePath, elt)] | |
63 | listElements subpath parser = do | |
64 | home <- getSpecificationHome | |
65 | let directory = home </> subpath | |
66 | files <- sort <$> liftIO (listDirectory directory) | |
67 | let prependDirectory f = directory </> f | |
68 | fmap (first prependDirectory) . catMaybes <$> traverse (extractElement parser) files | |
69 | ||
70 | getSpecificationHome :: Scaffolding FilePath | |
71 | getSpecificationHome = | |
72 | let concatenate path (Revision rev) = path </> rev | |
73 | in asks (concatenate . specificationsHome) <*> asks revision | |
74 | ||
75 | extractElement :: Show elt => Parsec String () elt -> FilePath -> Scaffolding (Maybe (FilePath, elt)) | |
76 | extractElement parser path = silent (fmap (path,) <$> maybeParse path parser path) | |
77 | ||
78 | skipBeginning :: Stream s Identity Char => Parsec s () a -> Parsec s () a | |
79 | skipBeginning p = manyTill anyChar (try (lookAhead p)) *> p | |
80 | ||
81 | single :: Stream s Identity Char => Parsec s u a -> Parsec s u [a] | |
82 | single = count 1 | |
83 | ||
84 | presenceParser :: Stream s Identity Char => Parsec s u Presence | |
85 | presenceParser = | |
86 | choice [ Mandatory <$ char 'M' | |
87 | , Optional <$ char 'C' | |
88 | ] <?> "Presence" | |
89 | ||
90 | stringToPresenceParser :: Stream s Identity Char => Parsec s u Text | |
91 | stringToPresenceParser = fromString <$> | |
92 | manyTill anyChar (try $ lookAhead $ many1 (string " ") >> presenceParser >> string " " >> many (oneOf " 0123456789")) | |
93 | <?> "Description" | |
94 | ||
95 | messageCodeParser :: Stream s Identity Char => Parsec s u MessageCode | |
96 | messageCodeParser = fromString <$> count 6 upper | |
97 | ||
98 | scanDependencies :: (Monoid u, Show result) => FilePath -> Parsec String u [result] -> Scaffolding (Maybe (NonEmpty result)) | |
99 | scanDependencies file parser = | |
100 | let readLines = liftIO (readFile file) | |
101 | in readLines >>= fmap (nonEmpty =<<) . maybeParse file parser | |
102 | ||
103 | scan :: Stream s Identity Char => [Parsec s u [a]] -> Parsec s u [a] | |
104 | scan scanners = | |
105 | let parsers = (scanLine <$> scanners) <> [skipLine] | |
106 | end = choice [ () <$ try endOfLine | |
107 | , () <$ eof | |
108 | ] | |
109 | scanLine p = optionMaybe (try p) <* end | |
110 | skipLine = Nothing <$ manyTill anyChar end | |
111 | in concat . catMaybes <$> manyTill (choice parsers) eof | |
112 | ||
113 | scanUntil :: Stream s Identity Char => [Parsec s u a] -> Parsec s u a | |
114 | scanUntil scanners = | |
115 | let parsers = scanLine <$> scanners | |
116 | end = choice [ () <$ try endOfLine | |
117 | , () <$ eof | |
118 | ] | |
119 | searching = choice $ fmap (() <$) parsers <> [ () <$ eof ] | |
120 | scanLine p = p <* end | |
121 | skipLine = manyTill anyChar end | |
122 | in manyTill skipLine (try $ lookAhead searching) >> try (choice parsers) |