{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} module Hedgehog.Internal.Discovery ( PropertySource(..) , readProperties , findProperties , readDeclaration , Pos(..) , Position(..) ) where import Control.Exception (IOException, handle) import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.Char as Char import qualified Data.List as List import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Ord as Ord import Hedgehog.Internal.Property (PropertyName(..)) import Hedgehog.Internal.Source (LineNo(..), ColumnNo(..)) #if __GLASGOW_HASKELL__ < 808 import Data.Semigroup (Semigroup(..)) #endif ------------------------------------------------------------------------ -- Property Extraction newtype PropertySource = PropertySource { PropertySource -> Pos String propertySource :: Pos String } deriving (PropertySource -> PropertySource -> Bool (PropertySource -> PropertySource -> Bool) -> (PropertySource -> PropertySource -> Bool) -> Eq PropertySource forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: PropertySource -> PropertySource -> Bool $c/= :: PropertySource -> PropertySource -> Bool == :: PropertySource -> PropertySource -> Bool $c== :: PropertySource -> PropertySource -> Bool Eq, Eq PropertySource Eq PropertySource -> (PropertySource -> PropertySource -> Ordering) -> (PropertySource -> PropertySource -> Bool) -> (PropertySource -> PropertySource -> Bool) -> (PropertySource -> PropertySource -> Bool) -> (PropertySource -> PropertySource -> Bool) -> (PropertySource -> PropertySource -> PropertySource) -> (PropertySource -> PropertySource -> PropertySource) -> Ord PropertySource PropertySource -> PropertySource -> Bool PropertySource -> PropertySource -> Ordering PropertySource -> PropertySource -> PropertySource forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: PropertySource -> PropertySource -> PropertySource $cmin :: PropertySource -> PropertySource -> PropertySource max :: PropertySource -> PropertySource -> PropertySource $cmax :: PropertySource -> PropertySource -> PropertySource >= :: PropertySource -> PropertySource -> Bool $c>= :: PropertySource -> PropertySource -> Bool > :: PropertySource -> PropertySource -> Bool $c> :: PropertySource -> PropertySource -> Bool <= :: PropertySource -> PropertySource -> Bool $c<= :: PropertySource -> PropertySource -> Bool < :: PropertySource -> PropertySource -> Bool $c< :: PropertySource -> PropertySource -> Bool compare :: PropertySource -> PropertySource -> Ordering $ccompare :: PropertySource -> PropertySource -> Ordering $cp1Ord :: Eq PropertySource Ord, Int -> PropertySource -> ShowS [PropertySource] -> ShowS PropertySource -> String (Int -> PropertySource -> ShowS) -> (PropertySource -> String) -> ([PropertySource] -> ShowS) -> Show PropertySource forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [PropertySource] -> ShowS $cshowList :: [PropertySource] -> ShowS show :: PropertySource -> String $cshow :: PropertySource -> String showsPrec :: Int -> PropertySource -> ShowS $cshowsPrec :: Int -> PropertySource -> ShowS Show) readProperties :: MonadIO m => String -> FilePath -> m (Map PropertyName PropertySource) readProperties :: String -> String -> m (Map PropertyName PropertySource) readProperties String prefix String path = String -> String -> String -> Map PropertyName PropertySource findProperties String prefix String path (String -> Map PropertyName PropertySource) -> m String -> m (Map PropertyName PropertySource) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO String -> m String forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (String -> IO String readFile String path) readDeclaration :: MonadIO m => FilePath -> LineNo -> m (Maybe (String, Pos String)) readDeclaration :: String -> LineNo -> m (Maybe (String, Pos String)) readDeclaration String path LineNo line = do Maybe String mfile <- IO (Maybe String) -> m (Maybe String) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe String) -> m (Maybe String)) -> IO (Maybe String) -> m (Maybe String) forall a b. (a -> b) -> a -> b $ String -> IO (Maybe String) forall (m :: * -> *). MonadIO m => String -> m (Maybe String) readFileSafe String path Maybe (String, Pos String) -> m (Maybe (String, Pos String)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe (String, Pos String) -> m (Maybe (String, Pos String))) -> Maybe (String, Pos String) -> m (Maybe (String, Pos String)) forall a b. (a -> b) -> a -> b $ do String file <- Maybe String mfile [(String, Pos String)] -> Maybe (String, Pos String) forall a. [a] -> Maybe a takeHead ([(String, Pos String)] -> Maybe (String, Pos String)) -> ([(String, Pos String)] -> [(String, Pos String)]) -> [(String, Pos String)] -> Maybe (String, Pos String) forall b c a. (b -> c) -> (a -> b) -> a -> c . ((String, Pos String) -> (String, Pos String) -> Ordering) -> [(String, Pos String)] -> [(String, Pos String)] forall a. (a -> a -> Ordering) -> [a] -> [a] List.sortBy (((String, Pos String) -> Down LineNo) -> (String, Pos String) -> (String, Pos String) -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering Ord.comparing (((String, Pos String) -> Down LineNo) -> (String, Pos String) -> (String, Pos String) -> Ordering) -> ((String, Pos String) -> Down LineNo) -> (String, Pos String) -> (String, Pos String) -> Ordering forall a b. (a -> b) -> a -> b $ LineNo -> Down LineNo forall a. a -> Down a Ord.Down (LineNo -> Down LineNo) -> ((String, Pos String) -> LineNo) -> (String, Pos String) -> Down LineNo forall b c a. (b -> c) -> (a -> b) -> a -> c . Position -> LineNo posLine (Position -> LineNo) -> ((String, Pos String) -> Position) -> (String, Pos String) -> LineNo forall b c a. (b -> c) -> (a -> b) -> a -> c . Pos String -> Position forall a. Pos a -> Position posPostion (Pos String -> Position) -> ((String, Pos String) -> Pos String) -> (String, Pos String) -> Position forall b c a. (b -> c) -> (a -> b) -> a -> c . (String, Pos String) -> Pos String forall a b. (a, b) -> b snd) ([(String, Pos String)] -> [(String, Pos String)]) -> ([(String, Pos String)] -> [(String, Pos String)]) -> [(String, Pos String)] -> [(String, Pos String)] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((String, Pos String) -> Bool) -> [(String, Pos String)] -> [(String, Pos String)] forall a. (a -> Bool) -> [a] -> [a] filter ((LineNo -> LineNo -> Bool forall a. Ord a => a -> a -> Bool <= LineNo line) (LineNo -> Bool) -> ((String, Pos String) -> LineNo) -> (String, Pos String) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Position -> LineNo posLine (Position -> LineNo) -> ((String, Pos String) -> Position) -> (String, Pos String) -> LineNo forall b c a. (b -> c) -> (a -> b) -> a -> c . Pos String -> Position forall a. Pos a -> Position posPostion (Pos String -> Position) -> ((String, Pos String) -> Pos String) -> (String, Pos String) -> Position forall b c a. (b -> c) -> (a -> b) -> a -> c . (String, Pos String) -> Pos String forall a b. (a, b) -> b snd) ([(String, Pos String)] -> Maybe (String, Pos String)) -> [(String, Pos String)] -> Maybe (String, Pos String) forall a b. (a -> b) -> a -> b $ Map String (Pos String) -> [(String, Pos String)] forall k a. Map k a -> [(k, a)] Map.toList (String -> String -> Map String (Pos String) findDeclarations String path String file) readFileSafe :: MonadIO m => FilePath -> m (Maybe String) readFileSafe :: String -> m (Maybe String) readFileSafe String path = IO (Maybe String) -> m (Maybe String) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe String) -> m (Maybe String)) -> IO (Maybe String) -> m (Maybe String) forall a b. (a -> b) -> a -> b $ (IOException -> IO (Maybe String)) -> IO (Maybe String) -> IO (Maybe String) forall e a. Exception e => (e -> IO a) -> IO a -> IO a handle (\(IOException _ :: IOException) -> Maybe String -> IO (Maybe String) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe String forall a. Maybe a Nothing) (String -> Maybe String forall a. a -> Maybe a Just (String -> Maybe String) -> IO String -> IO (Maybe String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> IO String readFile String path) takeHead :: [a] -> Maybe a takeHead :: [a] -> Maybe a takeHead = \case [] -> Maybe a forall a. Maybe a Nothing a x : [a] _ -> a -> Maybe a forall a. a -> Maybe a Just a x findProperties :: String -> FilePath -> String -> Map PropertyName PropertySource findProperties :: String -> String -> String -> Map PropertyName PropertySource findProperties String prefix String path = (Pos String -> PropertySource) -> Map PropertyName (Pos String) -> Map PropertyName PropertySource forall a b k. (a -> b) -> Map k a -> Map k b Map.map Pos String -> PropertySource PropertySource (Map PropertyName (Pos String) -> Map PropertyName PropertySource) -> (String -> Map PropertyName (Pos String)) -> String -> Map PropertyName PropertySource forall b c a. (b -> c) -> (a -> b) -> a -> c . (String -> PropertyName) -> Map String (Pos String) -> Map PropertyName (Pos String) forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a Map.mapKeysMonotonic String -> PropertyName PropertyName (Map String (Pos String) -> Map PropertyName (Pos String)) -> (String -> Map String (Pos String)) -> String -> Map PropertyName (Pos String) forall b c a. (b -> c) -> (a -> b) -> a -> c . (String -> Pos String -> Bool) -> Map String (Pos String) -> Map String (Pos String) forall k a. (k -> a -> Bool) -> Map k a -> Map k a Map.filterWithKey (\String k Pos String _ -> String -> String -> Bool forall a. Eq a => [a] -> [a] -> Bool List.isPrefixOf String prefix String k) (Map String (Pos String) -> Map String (Pos String)) -> (String -> Map String (Pos String)) -> String -> Map String (Pos String) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String -> Map String (Pos String) findDeclarations String path findDeclarations :: FilePath -> String -> Map String (Pos String) findDeclarations :: String -> String -> Map String (Pos String) findDeclarations String path = [Classified (Pos Char)] -> Map String (Pos String) declarations ([Classified (Pos Char)] -> Map String (Pos String)) -> (String -> [Classified (Pos Char)]) -> String -> Map String (Pos String) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Pos Char] -> [Classified (Pos Char)] classified ([Pos Char] -> [Classified (Pos Char)]) -> (String -> [Pos Char]) -> String -> [Classified (Pos Char)] forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String -> [Pos Char] positioned String path ------------------------------------------------------------------------ -- Declaration Identification declarations :: [Classified (Pos Char)] -> Map String (Pos String) declarations :: [Classified (Pos Char)] -> Map String (Pos String) declarations = let loop :: [Classified (Pos Char)] -> [(String, Pos String)] loop = \case [] -> [] Classified (Pos Char) x : [Classified (Pos Char)] xs -> let ([Classified (Pos Char)] ys, [Classified (Pos Char)] zs) = (Classified (Pos Char) -> Bool) -> [Classified (Pos Char)] -> ([Classified (Pos Char)], [Classified (Pos Char)]) forall a. (a -> Bool) -> [a] -> ([a], [a]) break Classified (Pos Char) -> Bool isDeclaration [Classified (Pos Char)] xs in Pos String -> (String, Pos String) tagWithName (Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String forget Classified (Pos Char) x ([Classified (Pos Char)] -> Pos String) -> [Classified (Pos Char)] -> Pos String forall a b. (a -> b) -> a -> b $ [Classified (Pos Char)] -> [Classified (Pos Char)] trimEnd [Classified (Pos Char)] ys) (String, Pos String) -> [(String, Pos String)] -> [(String, Pos String)] forall a. a -> [a] -> [a] : [Classified (Pos Char)] -> [(String, Pos String)] loop [Classified (Pos Char)] zs in (Pos String -> Pos String -> Pos String) -> [(String, Pos String)] -> Map String (Pos String) forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a Map.fromListWith Pos String -> Pos String -> Pos String forall a. Semigroup a => a -> a -> a (<>) ([(String, Pos String)] -> Map String (Pos String)) -> ([Classified (Pos Char)] -> [(String, Pos String)]) -> [Classified (Pos Char)] -> Map String (Pos String) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Classified (Pos Char)] -> [(String, Pos String)] loop ([Classified (Pos Char)] -> [(String, Pos String)]) -> ([Classified (Pos Char)] -> [Classified (Pos Char)]) -> [Classified (Pos Char)] -> [(String, Pos String)] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Classified (Pos Char) -> Bool) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. (a -> Bool) -> [a] -> [a] dropWhile (Bool -> Bool not (Bool -> Bool) -> (Classified (Pos Char) -> Bool) -> Classified (Pos Char) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Classified (Pos Char) -> Bool isDeclaration) trimEnd :: [Classified (Pos Char)] -> [Classified (Pos Char)] trimEnd :: [Classified (Pos Char)] -> [Classified (Pos Char)] trimEnd [Classified (Pos Char)] xs = let ([Classified (Pos Char)] space0, [Classified (Pos Char)] code) = (Classified (Pos Char) -> Bool) -> [Classified (Pos Char)] -> ([Classified (Pos Char)], [Classified (Pos Char)]) forall a. (a -> Bool) -> [a] -> ([a], [a]) span Classified (Pos Char) -> Bool isWhitespace ([Classified (Pos Char)] -> ([Classified (Pos Char)], [Classified (Pos Char)])) -> [Classified (Pos Char)] -> ([Classified (Pos Char)], [Classified (Pos Char)]) forall a b. (a -> b) -> a -> b $ [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. [a] -> [a] reverse [Classified (Pos Char)] xs ([Classified (Pos Char)] line_tail0, [Classified (Pos Char)] space) = (Classified (Pos Char) -> Bool) -> [Classified (Pos Char)] -> ([Classified (Pos Char)], [Classified (Pos Char)]) forall a. (a -> Bool) -> [a] -> ([a], [a]) span (\(Classified Class _ (Pos Position _ Char x)) -> Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /= Char '\n') ([Classified (Pos Char)] -> ([Classified (Pos Char)], [Classified (Pos Char)])) -> [Classified (Pos Char)] -> ([Classified (Pos Char)], [Classified (Pos Char)]) forall a b. (a -> b) -> a -> b $ [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. [a] -> [a] reverse [Classified (Pos Char)] space0 line_tail :: [Classified (Pos Char)] line_tail = case [Classified (Pos Char)] space of [] -> [Classified (Pos Char)] line_tail0 Classified (Pos Char) x : [Classified (Pos Char)] _ -> [Classified (Pos Char)] line_tail0 [Classified (Pos Char)] -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. [a] -> [a] -> [a] ++ [Classified (Pos Char) x] in [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. [a] -> [a] reverse [Classified (Pos Char)] code [Classified (Pos Char)] -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. [a] -> [a] -> [a] ++ [Classified (Pos Char)] line_tail isWhitespace :: Classified (Pos Char) -> Bool isWhitespace :: Classified (Pos Char) -> Bool isWhitespace (Classified Class c (Pos Position _ Char x)) = Class c Class -> Class -> Bool forall a. Eq a => a -> a -> Bool == Class Comment Bool -> Bool -> Bool || Char -> Bool Char.isSpace Char x tagWithName :: Pos String -> (String, Pos String) tagWithName :: Pos String -> (String, Pos String) tagWithName (Pos Position p String x) = (ShowS takeName String x, Position -> String -> Pos String forall a. Position -> a -> Pos a Pos Position p String x) takeName :: String -> String takeName :: ShowS takeName String xs = case String -> [String] words String xs of [] -> String "" String x : [String] _ -> String x forget :: Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String forget :: Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String forget (Classified Class _ (Pos Position p Char x)) [Classified (Pos Char)] xs = Position -> String -> Pos String forall a. Position -> a -> Pos a Pos Position p (String -> Pos String) -> String -> Pos String forall a b. (a -> b) -> a -> b $ Char x Char -> ShowS forall a. a -> [a] -> [a] : (Classified (Pos Char) -> Char) -> [Classified (Pos Char)] -> String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Pos Char -> Char forall a. Pos a -> a posValue (Pos Char -> Char) -> (Classified (Pos Char) -> Pos Char) -> Classified (Pos Char) -> Char forall b c a. (b -> c) -> (a -> b) -> a -> c . Classified (Pos Char) -> Pos Char forall a. Classified a -> a classifiedValue) [Classified (Pos Char)] xs isDeclaration :: Classified (Pos Char) -> Bool isDeclaration :: Classified (Pos Char) -> Bool isDeclaration (Classified Class c (Pos Position p Char x)) = Class c Class -> Class -> Bool forall a. Eq a => a -> a -> Bool == Class NotComment Bool -> Bool -> Bool && Position -> ColumnNo posColumn Position p ColumnNo -> ColumnNo -> Bool forall a. Eq a => a -> a -> Bool == ColumnNo 1 Bool -> Bool -> Bool && (Char -> Bool Char.isLower Char x Bool -> Bool -> Bool || Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '_') ------------------------------------------------------------------------ -- Comment Classification data Class = NotComment | Comment deriving (Class -> Class -> Bool (Class -> Class -> Bool) -> (Class -> Class -> Bool) -> Eq Class forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Class -> Class -> Bool $c/= :: Class -> Class -> Bool == :: Class -> Class -> Bool $c== :: Class -> Class -> Bool Eq, Eq Class Eq Class -> (Class -> Class -> Ordering) -> (Class -> Class -> Bool) -> (Class -> Class -> Bool) -> (Class -> Class -> Bool) -> (Class -> Class -> Bool) -> (Class -> Class -> Class) -> (Class -> Class -> Class) -> Ord Class Class -> Class -> Bool Class -> Class -> Ordering Class -> Class -> Class forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Class -> Class -> Class $cmin :: Class -> Class -> Class max :: Class -> Class -> Class $cmax :: Class -> Class -> Class >= :: Class -> Class -> Bool $c>= :: Class -> Class -> Bool > :: Class -> Class -> Bool $c> :: Class -> Class -> Bool <= :: Class -> Class -> Bool $c<= :: Class -> Class -> Bool < :: Class -> Class -> Bool $c< :: Class -> Class -> Bool compare :: Class -> Class -> Ordering $ccompare :: Class -> Class -> Ordering $cp1Ord :: Eq Class Ord, Int -> Class -> ShowS [Class] -> ShowS Class -> String (Int -> Class -> ShowS) -> (Class -> String) -> ([Class] -> ShowS) -> Show Class forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Class] -> ShowS $cshowList :: [Class] -> ShowS show :: Class -> String $cshow :: Class -> String showsPrec :: Int -> Class -> ShowS $cshowsPrec :: Int -> Class -> ShowS Show) data Classified a = Classified { Classified a -> Class _classifiedClass :: !Class , Classified a -> a classifiedValue :: !a } deriving (Classified a -> Classified a -> Bool (Classified a -> Classified a -> Bool) -> (Classified a -> Classified a -> Bool) -> Eq (Classified a) forall a. Eq a => Classified a -> Classified a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Classified a -> Classified a -> Bool $c/= :: forall a. Eq a => Classified a -> Classified a -> Bool == :: Classified a -> Classified a -> Bool $c== :: forall a. Eq a => Classified a -> Classified a -> Bool Eq, Eq (Classified a) Eq (Classified a) -> (Classified a -> Classified a -> Ordering) -> (Classified a -> Classified a -> Bool) -> (Classified a -> Classified a -> Bool) -> (Classified a -> Classified a -> Bool) -> (Classified a -> Classified a -> Bool) -> (Classified a -> Classified a -> Classified a) -> (Classified a -> Classified a -> Classified a) -> Ord (Classified a) Classified a -> Classified a -> Bool Classified a -> Classified a -> Ordering Classified a -> Classified a -> Classified a forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall a. Ord a => Eq (Classified a) forall a. Ord a => Classified a -> Classified a -> Bool forall a. Ord a => Classified a -> Classified a -> Ordering forall a. Ord a => Classified a -> Classified a -> Classified a min :: Classified a -> Classified a -> Classified a $cmin :: forall a. Ord a => Classified a -> Classified a -> Classified a max :: Classified a -> Classified a -> Classified a $cmax :: forall a. Ord a => Classified a -> Classified a -> Classified a >= :: Classified a -> Classified a -> Bool $c>= :: forall a. Ord a => Classified a -> Classified a -> Bool > :: Classified a -> Classified a -> Bool $c> :: forall a. Ord a => Classified a -> Classified a -> Bool <= :: Classified a -> Classified a -> Bool $c<= :: forall a. Ord a => Classified a -> Classified a -> Bool < :: Classified a -> Classified a -> Bool $c< :: forall a. Ord a => Classified a -> Classified a -> Bool compare :: Classified a -> Classified a -> Ordering $ccompare :: forall a. Ord a => Classified a -> Classified a -> Ordering $cp1Ord :: forall a. Ord a => Eq (Classified a) Ord, Int -> Classified a -> ShowS [Classified a] -> ShowS Classified a -> String (Int -> Classified a -> ShowS) -> (Classified a -> String) -> ([Classified a] -> ShowS) -> Show (Classified a) forall a. Show a => Int -> Classified a -> ShowS forall a. Show a => [Classified a] -> ShowS forall a. Show a => Classified a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Classified a] -> ShowS $cshowList :: forall a. Show a => [Classified a] -> ShowS show :: Classified a -> String $cshow :: forall a. Show a => Classified a -> String showsPrec :: Int -> Classified a -> ShowS $cshowsPrec :: forall a. Show a => Int -> Classified a -> ShowS Show) classified :: [Pos Char] -> [Classified (Pos Char)] classified :: [Pos Char] -> [Classified (Pos Char)] classified = let ok :: a -> Classified a ok = Class -> a -> Classified a forall a. Class -> a -> Classified a Classified Class NotComment ko :: a -> Classified a ko = Class -> a -> Classified a forall a. Class -> a -> Classified a Classified Class Comment loop :: a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop a nesting Bool in_line = \case [] -> [] x :: Pos Char x@(Pos Position _ Char '\n') : [Pos Char] xs | Bool in_line -> Pos Char -> Classified (Pos Char) forall a. a -> Classified a ok Pos Char x Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop a nesting Bool False [Pos Char] xs Pos Char x : [Pos Char] xs | Bool in_line -> Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char x Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop a nesting Bool in_line [Pos Char] xs x :: Pos Char x@(Pos Position _ Char '{') : y :: Pos Char y@(Pos Position _ Char '-') : [Pos Char] xs -> Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char x Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char y Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop (a nesting a -> a -> a forall a. Num a => a -> a -> a + a 1) Bool in_line [Pos Char] xs x :: Pos Char x@(Pos Position _ Char '-') : y :: Pos Char y@(Pos Position _ Char '}') : [Pos Char] xs | a nesting a -> a -> Bool forall a. Ord a => a -> a -> Bool > a 0 -> Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char x Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char y Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop (a nesting a -> a -> a forall a. Num a => a -> a -> a - a 1) Bool in_line [Pos Char] xs Pos Char x : [Pos Char] xs | a nesting a -> a -> Bool forall a. Ord a => a -> a -> Bool > a 0 -> Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char x Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop a nesting Bool in_line [Pos Char] xs -- FIXME This is not technically correct, we should allow arbitrary runs -- FIXME of dashes followed by a symbol character. Here we have only -- FIXME allowed two. x :: Pos Char x@(Pos Position _ Char '-') : y :: Pos Char y@(Pos Position _ Char '-') : z :: Pos Char z@(Pos Position _ Char zz) : [Pos Char] xs | Bool -> Bool not (Char -> Bool Char.isSymbol Char zz) -> Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char x Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : Pos Char -> Classified (Pos Char) forall a. a -> Classified a ko Pos Char y Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop a nesting Bool True (Pos Char z Pos Char -> [Pos Char] -> [Pos Char] forall a. a -> [a] -> [a] : [Pos Char] xs) Pos Char x : [Pos Char] xs -> Pos Char -> Classified (Pos Char) forall a. a -> Classified a ok Pos Char x Classified (Pos Char) -> [Classified (Pos Char)] -> [Classified (Pos Char)] forall a. a -> [a] -> [a] : a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop a nesting Bool in_line [Pos Char] xs in Int -> Bool -> [Pos Char] -> [Classified (Pos Char)] forall a. (Num a, Ord a) => a -> Bool -> [Pos Char] -> [Classified (Pos Char)] loop (Int 0 :: Int) Bool False ------------------------------------------------------------------------ -- Character Positioning data Position = Position { Position -> String _posPath :: !FilePath , Position -> LineNo posLine :: !LineNo , Position -> ColumnNo posColumn :: !ColumnNo } deriving (Position -> Position -> Bool (Position -> Position -> Bool) -> (Position -> Position -> Bool) -> Eq Position forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Position -> Position -> Bool $c/= :: Position -> Position -> Bool == :: Position -> Position -> Bool $c== :: Position -> Position -> Bool Eq, Eq Position Eq Position -> (Position -> Position -> Ordering) -> (Position -> Position -> Bool) -> (Position -> Position -> Bool) -> (Position -> Position -> Bool) -> (Position -> Position -> Bool) -> (Position -> Position -> Position) -> (Position -> Position -> Position) -> Ord Position Position -> Position -> Bool Position -> Position -> Ordering Position -> Position -> Position forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Position -> Position -> Position $cmin :: Position -> Position -> Position max :: Position -> Position -> Position $cmax :: Position -> Position -> Position >= :: Position -> Position -> Bool $c>= :: Position -> Position -> Bool > :: Position -> Position -> Bool $c> :: Position -> Position -> Bool <= :: Position -> Position -> Bool $c<= :: Position -> Position -> Bool < :: Position -> Position -> Bool $c< :: Position -> Position -> Bool compare :: Position -> Position -> Ordering $ccompare :: Position -> Position -> Ordering $cp1Ord :: Eq Position Ord, Int -> Position -> ShowS [Position] -> ShowS Position -> String (Int -> Position -> ShowS) -> (Position -> String) -> ([Position] -> ShowS) -> Show Position forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Position] -> ShowS $cshowList :: [Position] -> ShowS show :: Position -> String $cshow :: Position -> String showsPrec :: Int -> Position -> ShowS $cshowsPrec :: Int -> Position -> ShowS Show) data Pos a = Pos { Pos a -> Position posPostion :: !Position , Pos a -> a posValue :: a } deriving (Pos a -> Pos a -> Bool (Pos a -> Pos a -> Bool) -> (Pos a -> Pos a -> Bool) -> Eq (Pos a) forall a. Eq a => Pos a -> Pos a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Pos a -> Pos a -> Bool $c/= :: forall a. Eq a => Pos a -> Pos a -> Bool == :: Pos a -> Pos a -> Bool $c== :: forall a. Eq a => Pos a -> Pos a -> Bool Eq, Eq (Pos a) Eq (Pos a) -> (Pos a -> Pos a -> Ordering) -> (Pos a -> Pos a -> Bool) -> (Pos a -> Pos a -> Bool) -> (Pos a -> Pos a -> Bool) -> (Pos a -> Pos a -> Bool) -> (Pos a -> Pos a -> Pos a) -> (Pos a -> Pos a -> Pos a) -> Ord (Pos a) Pos a -> Pos a -> Bool Pos a -> Pos a -> Ordering Pos a -> Pos a -> Pos a forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall a. Ord a => Eq (Pos a) forall a. Ord a => Pos a -> Pos a -> Bool forall a. Ord a => Pos a -> Pos a -> Ordering forall a. Ord a => Pos a -> Pos a -> Pos a min :: Pos a -> Pos a -> Pos a $cmin :: forall a. Ord a => Pos a -> Pos a -> Pos a max :: Pos a -> Pos a -> Pos a $cmax :: forall a. Ord a => Pos a -> Pos a -> Pos a >= :: Pos a -> Pos a -> Bool $c>= :: forall a. Ord a => Pos a -> Pos a -> Bool > :: Pos a -> Pos a -> Bool $c> :: forall a. Ord a => Pos a -> Pos a -> Bool <= :: Pos a -> Pos a -> Bool $c<= :: forall a. Ord a => Pos a -> Pos a -> Bool < :: Pos a -> Pos a -> Bool $c< :: forall a. Ord a => Pos a -> Pos a -> Bool compare :: Pos a -> Pos a -> Ordering $ccompare :: forall a. Ord a => Pos a -> Pos a -> Ordering $cp1Ord :: forall a. Ord a => Eq (Pos a) Ord, Int -> Pos a -> ShowS [Pos a] -> ShowS Pos a -> String (Int -> Pos a -> ShowS) -> (Pos a -> String) -> ([Pos a] -> ShowS) -> Show (Pos a) forall a. Show a => Int -> Pos a -> ShowS forall a. Show a => [Pos a] -> ShowS forall a. Show a => Pos a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Pos a] -> ShowS $cshowList :: forall a. Show a => [Pos a] -> ShowS show :: Pos a -> String $cshow :: forall a. Show a => Pos a -> String showsPrec :: Int -> Pos a -> ShowS $cshowsPrec :: forall a. Show a => Int -> Pos a -> ShowS Show, a -> Pos b -> Pos a (a -> b) -> Pos a -> Pos b (forall a b. (a -> b) -> Pos a -> Pos b) -> (forall a b. a -> Pos b -> Pos a) -> Functor Pos forall a b. a -> Pos b -> Pos a forall a b. (a -> b) -> Pos a -> Pos b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> Pos b -> Pos a $c<$ :: forall a b. a -> Pos b -> Pos a fmap :: (a -> b) -> Pos a -> Pos b $cfmap :: forall a b. (a -> b) -> Pos a -> Pos b Functor) instance Semigroup a => Semigroup (Pos a) where <> :: Pos a -> Pos a -> Pos a (<>) (Pos Position p a x) (Pos Position q a y) = if Position p Position -> Position -> Bool forall a. Ord a => a -> a -> Bool < Position q then Position -> a -> Pos a forall a. Position -> a -> Pos a Pos Position p (a x a -> a -> a forall a. Semigroup a => a -> a -> a <> a y) else Position -> a -> Pos a forall a. Position -> a -> Pos a Pos Position q (a y a -> a -> a forall a. Semigroup a => a -> a -> a <> a x) positioned :: FilePath -> [Char] -> [Pos Char] positioned :: String -> String -> [Pos Char] positioned String path = let loop :: LineNo -> ColumnNo -> String -> [Pos Char] loop LineNo l ColumnNo c = \case [] -> [] Char '\n' : String xs -> Position -> Char -> Pos Char forall a. Position -> a -> Pos a Pos (String -> LineNo -> ColumnNo -> Position Position String path LineNo l ColumnNo c) Char '\n' Pos Char -> [Pos Char] -> [Pos Char] forall a. a -> [a] -> [a] : LineNo -> ColumnNo -> String -> [Pos Char] loop (LineNo l LineNo -> LineNo -> LineNo forall a. Num a => a -> a -> a + LineNo 1) ColumnNo 1 String xs Char x : String xs -> Position -> Char -> Pos Char forall a. Position -> a -> Pos a Pos (String -> LineNo -> ColumnNo -> Position Position String path LineNo l ColumnNo c) Char x Pos Char -> [Pos Char] -> [Pos Char] forall a. a -> [a] -> [a] : LineNo -> ColumnNo -> String -> [Pos Char] loop LineNo l (ColumnNo c ColumnNo -> ColumnNo -> ColumnNo forall a. Num a => a -> a -> a + ColumnNo 1) String xs in LineNo -> ColumnNo -> String -> [Pos Char] loop LineNo 1 ColumnNo 1