{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module Uniform.PathShowCase
( module Uniform.PathShowCase
, module Path )
where
import Uniform.Strings
import Path
readsPrecForPath :: ([Char] -> Maybe a)
-> [Char] -> String -> [Char] -> [(a, [Char])]
readsPrecForPath :: ([Char] -> Maybe a) -> [Char] -> [Char] -> [Char] -> [(a, [Char])]
readsPrecForPath [Char] -> Maybe a
parseAD [Char]
prefix1 [Char]
msg [Char]
a0 =
if ([Char]
prefix1 [Char] -> [Char] -> Bool
forall a. CharChains a => a -> a -> Bool
`isPrefixOf'` [Char]
a1 )
then [ (a
res2, [Char]
rem2)]
else [Char] -> [(a, [Char])]
forall a. HasCallStack => [Char] -> a
error ([Char]
"not a prefix for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" input " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
a1)
where
a1 :: [Char]
a1 = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
a0
a2 :: Maybe [Char]
a2 = [Char] -> [Char] -> Maybe [Char]
forall a. CharChains a => a -> a -> Maybe a
stripPrefix' [Char]
prefix1 [Char]
a1
a3 :: [Char]
a3 = [Char] -> Maybe [Char] -> [Char]
forall a. HasCallStack => [Char] -> Maybe a -> a
fromJustNote [Char]
"readPrec not prefix" Maybe [Char]
a2
([Char]
a4,[Char]
rem2) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
terminate [Char]
a3
res1 :: Maybe a
res1 = [Char] -> Maybe a
parseAD [Char]
a4
res2 :: a
res2 = [Char] -> Maybe a -> a
forall a. HasCallStack => [Char] -> Maybe a -> a
fromJustNote ([[Char]] -> [Char]
unwords[[Char]
"not a path ", [Char]
msg, [Char]
"input", [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
a0]) Maybe a
res1
terminate :: Char -> Bool
terminate :: Char -> Bool
terminate Char
c = Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
',',Char
'}']
instance Read (Path Abs Dir) where
readsPrec :: Int -> ReadS (Path Abs Dir)
readsPrec Int
_ = ([Char] -> Maybe (Path Abs Dir))
-> [Char] -> [Char] -> ReadS (Path Abs Dir)
forall a.
([Char] -> Maybe a) -> [Char] -> [Char] -> [Char] -> [(a, [Char])]
readsPrecForPath [Char] -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs Dir)
parseAbsDir [Char]
prefixAbsDir [Char]
"Abs Dir"
instance Read (Path Abs File) where
readsPrec :: Int -> ReadS (Path Abs File)
readsPrec Int
_ = ([Char] -> Maybe (Path Abs File))
-> [Char] -> [Char] -> ReadS (Path Abs File)
forall a.
([Char] -> Maybe a) -> [Char] -> [Char] -> [Char] -> [(a, [Char])]
readsPrecForPath [Char] -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile [Char]
prefixAbsFile [Char]
"Abs File"
instance Read (Path Rel File) where
readsPrec :: Int -> ReadS (Path Rel File)
readsPrec Int
_ = ([Char] -> Maybe (Path Rel File))
-> [Char] -> [Char] -> ReadS (Path Rel File)
forall a.
([Char] -> Maybe a) -> [Char] -> [Char] -> [Char] -> [(a, [Char])]
readsPrecForPath [Char] -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
prefixRelFile [Char]
"Rel File"
instance Read (Path Rel Dir) where
readsPrec :: Int -> ReadS (Path Rel Dir)
readsPrec Int
_ = ([Char] -> Maybe (Path Rel Dir))
-> [Char] -> [Char] -> ReadS (Path Rel Dir)
forall a.
([Char] -> Maybe a) -> [Char] -> [Char] -> [Char] -> [(a, [Char])]
readsPrecForPath [Char] -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir [Char]
prefixRelDir [Char]
"Rel Dir"
instance {-# OVERLAPPING #-} Show (Path Abs Dir) where
show :: Path Abs Dir -> [Char]
show Path Abs Dir
a = [[Char]] -> [Char]
forall a. CharChains a => [a] -> a
concat' [[Char]
prefixAbsDir, Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
a]
instance {-# OVERLAPPING #-} Show (Path Abs File) where
show :: Path Abs File -> [Char]
show Path Abs File
a = [[Char]] -> [Char]
forall a. CharChains a => [a] -> a
concat' [[Char]
prefixAbsFile, Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
a]
instance {-# OVERLAPPING #-} Show (Path Rel File) where
show :: Path Rel File -> [Char]
show Path Rel File
a = [[Char]] -> [Char]
forall a. CharChains a => [a] -> a
concat' [[Char]
prefixRelFile, Path Rel File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Rel File
a]
instance {-# OVERLAPPING #-} Show (Path Rel Dir) where
show :: Path Rel Dir -> [Char]
show Path Rel Dir
a = [[Char]] -> [Char]
forall a. CharChains a => [a] -> a
concat' [[Char]
prefixRelDir, Path Rel Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Rel Dir
a]
instance NiceStrings (Path a b) where
showNice :: Path a b -> Text
showNice = [Char] -> Text
s2t ([Char] -> Text) -> (Path a b -> [Char]) -> Path a b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path a b -> [Char]
forall b t. Path b t -> [Char]
toFilePath
instance PrettyStrings (Path a b) where
showPretty :: Path a b -> Text
showPretty = Path a b -> Text
forall a. NiceStrings a => a -> Text
showNice
toFilePathT :: Path b t -> Text
toFilePathT :: Path b t -> Text
toFilePathT = [Char] -> Text
s2t ([Char] -> Text) -> (Path b t -> [Char]) -> Path b t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> [Char]
forall b t. Path b t -> [Char]
toFilePath
prefixAbsDir, prefixAbsFile, prefixRelDir, prefixRelFile :: String
prefixAbsFile :: [Char]
prefixAbsFile = [Char]
"Path Abs File "
prefixAbsDir :: [Char]
prefixAbsDir = [Char]
"Path Abs Dir "
prefixRelFile :: [Char]
prefixRelFile = [Char]
"Path Rel File "
prefixRelDir :: [Char]
prefixRelDir = [Char]
"Path Rel Dir "