1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE TupleSections #-}
4 module Text.Edifact.Scaffolder.Commons.Parsing
14 , stringToPresenceParser
23 import Text.Edifact.Scaffolder.Commons.Logging (say)
24 import Text.Edifact.Scaffolder.Commons.Types
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,
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)
56 -- | Disable parsing error logging locally
57 silent :: Scaffolding a -> Scaffolding a
58 silent = local disableDebugging
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
70 getSpecificationHome :: Scaffolding FilePath
71 getSpecificationHome =
72 let concatenate path (Revision rev) = path </> rev
73 in asks (concatenate . specificationsHome) <*> asks revision
75 extractElement :: Show elt => Parsec String () elt -> FilePath -> Scaffolding (Maybe (FilePath, elt))
76 extractElement parser path = silent (fmap (path,) <$> maybeParse path parser path)
78 skipBeginning :: Stream s Identity Char => Parsec s () a -> Parsec s () a
79 skipBeginning p = manyTill anyChar (try (lookAhead p)) *> p
81 single :: Stream s Identity Char => Parsec s u a -> Parsec s u [a]
84 presenceParser :: Stream s Identity Char => Parsec s u Presence
86 choice [ Mandatory <$ char 'M'
87 , Optional <$ char 'C'
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"))
95 messageCodeParser :: Stream s Identity Char => Parsec s u MessageCode
96 messageCodeParser = fromString <$> count 6 upper
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
103 scan :: Stream s Identity Char => [Parsec s u [a]] -> Parsec s u [a]
105 let parsers = (scanLine <$> scanners) <> [skipLine]
106 end = choice [ () <$ try endOfLine
109 scanLine p = optionMaybe (try p) <* end
110 skipLine = Nothing <$ manyTill anyChar end
111 in concat . catMaybes <$> manyTill (choice parsers) eof
113 scanUntil :: Stream s Identity Char => [Parsec s u a] -> Parsec s u a
115 let parsers = scanLine <$> scanners
116 end = choice [ () <$ try endOfLine
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)