-- | This module provides a simple example of use of everything in -- Pinchot. 'address' parses a postal address from a string and -- prints a simple report showing some of the elements of the -- address and their locations. module Pinchot.Examples.Newman where import Pinchot import Pinchot.Pretty import Pinchot.Examples.Earley import Pinchot.Examples.SyntaxTrees import Pinchot.Examples.Terminalize import Pinchot.Examples.RulesToOptics import qualified Control.Lens as Lens import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty, toList) import qualified Data.List.NonEmpty as NE import qualified Text.Earley as Earley import qualified Text.Show.Pretty as Pretty -- | Formats a 'Loc' for nice on-screen display. labelLoc :: Loc -> String labelLoc (Loc l c p) = "(line: " ++ show l ++ " col: " ++ show c ++ " pos: " ++ show p ++ ")" -- | Labels a single field, where the field may or may not appear in -- a parsed result. labelOpt :: String -> [(Char, Loc)] -> String labelOpt l sq = l ++ ": " ++ show (fmap fst $ sq) ++ " " ++ loc ++ "\n" where loc = case Lens.uncons sq of Nothing -> "(no location)" Just ((_, loc), _) -> labelLoc loc -- | Labels a single field, where the field will always appear in a -- parsed result. labelNE :: String -> NonEmpty (Char, Loc) -> String labelNE l sq = l ++ ": " ++ show (toList . fmap fst $ sq) ++ " " ++ loc ++ "\n" where loc = labelLoc . snd . NE.head $ sq -- | Formats a single 'Address' for nice on-screen display. showAddress :: Address Char Loc -> String showAddress a = name ++ street ++ city where name = labelNE "Name" . t'Words . _r'NameLine'0'Words . _r'Address'0'NameLine $ a street = number ++ pre ++ streetName ++ suf where number = labelNE "Number" . t'Number . _r'StreetLine'0'Number . _r'Address'1'StreetLine $ a pre = labelOpt "Direction prefix" . maybe [] NE.toList . Lens.preview (r'Address'1'StreetLine . r'StreetLine'2'DirectionSpace'Opt . Lens._Wrapped' . Lens._Just . r'DirectionSpace'0'Direction . Lens.to t'Direction) $ a streetName = labelNE "Street" . t'StreetName . _r'StreetLine'3'StreetName . _r'Address'1'StreetLine $ a suf = labelOpt "Street suffix" . maybe [] NE.toList . Lens.preview (r'Address'1'StreetLine . r'StreetLine'4'SpaceSuffix'Opt . Lens._Wrapped' . Lens._Just . r'SpaceSuffix'1'Suffix . Lens.to t'Suffix) $ a city = cty ++ st ++ zip where cty = labelNE "City" . t'City . _r'CityLine'0'City . _r'Address'2'CityLine $ a st = labelNE "State" . t'State . _r'CityLine'3'State . _r'Address'2'CityLine $ a zip = labelNE "Zip" . t'ZipCode . _r'CityLine'5'ZipCode . _r'Address'2'CityLine $ a -- | Formats successful 'Address' parses and the 'Earley.Report' for -- nice on-screen display. showParseResult :: ([Address Char Loc], Earley.Report String [(Char, Loc)]) -> String showParseResult (addresses, report) = addresses' ++ "\n" ++ report' where addresses' = ("Full parses:\n\n" ++) . concat . intersperse "---\n" . map showAddress $ addresses report' = ("Earley report:\n\n" ++) . show $ report { Earley.unconsumed = fmap fst . Earley.unconsumed $ report } -- | Parse an address and print the resulting report. Good for use -- in GHCi. address :: String -> IO () address = putStrLn . showParseResult . locatedFullParses addressGrammar -- | Like 'address' but uses 'Pretty.valToStr'. addressPretty :: String -> IO () addressPretty = putStrLn . Pretty.valToStr . prettyFullParses . locatedFullParses addressGrammar -- | Read an address from a file and print the resulting report. -- Good for use in GHCi. addressFromFile :: String -- ^ Filename -> IO () addressFromFile fn = readFile fn >>= address