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
labelLoc :: Loc -> String
labelLoc (Loc l c p)
= "(line: " ++ show l ++ " col: " ++ show c ++ " pos: "
++ show p ++ ")"
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
labelNE :: String -> NonEmpty (Char, Loc) -> String
labelNE l sq
= l ++ ": " ++ show (toList . fmap fst $ sq)
++ " " ++ loc ++ "\n"
where
loc = labelLoc . snd . NE.head $ sq
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
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 }
address :: String -> IO ()
address = putStrLn . showParseResult . locatedFullParses addressGrammar
addressPretty :: String -> IO ()
addressPretty = putStrLn . Pretty.valToStr
. prettyFullParses . locatedFullParses addressGrammar
addressFromFile
:: String
-> IO ()
addressFromFile fn = readFile fn >>= address