> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module : LTK.Porters
> Copyright : (c) 2018-2020 Dakotah Lambert
> License   : MIT
> 
> This module provides methods to convert automata to and from
> various formats.
> -}

> module LTK.Porters
>        ( -- *Conversions
>          -- |In the following definitions,
>          -- @(Type t)@ is shorthand for @(String -> t)@.
>          from
>        , fromE
>        , to
>        -- *Formats
>        -- |We use types to create a bit of magic
>        -- in order to read and write automata in
>        -- various formats.
>        , Type
>        , Dot(Dot)
>        , Jeff(Jeff)
>        , Pleb(Pleb)
>        , ATT(ATT)
>        , ATTO(ATTO)
>        , Corpus(Corpus)
>        -- *Miscellaneous
>        , formatSet
>        , transliterate
>        , transliterateString
>        , untransliterate
>        , untransliterateString
>        , Importable(..)
>        , Exportable(..)
>        ) where

> import LTK.FSA          (FSA, renameStates, renameSymbolsBy)
> import LTK.Porters.ATT  ( exportATT
>                         , invertATT
>                         , readATT
>                         )
> import LTK.Porters.Corpus (readCorpus)
> import LTK.Porters.Dot  (exportDot, formatSet)
> import LTK.Porters.Jeff ( exportJeff
>                         , readJeff
>                         , transliterate
>                         , transliterateString
>                         , untransliterate
>                         , untransliterateString
>                         )
> import LTK.Porters.Pleb (readPleb)

> -- |A type that can be written from an 'FSA'.
> class Exportable t
>     where fromFSA  ::  (Ord n, Ord e, Show n, Show e) =>
>                        (t -> t) -> FSA n e -> String

> -- |A type that can be read and turned into an 'FSA'.
> class Importable t
>     where toFSA :: (t -> t) -> String -> Either String (FSA Integer String)

> -- |Create an 'FSA' from a @String@ treated as the given 'Type'.
> from :: (Importable i) => Type i -> String -> FSA Integer String
> from :: Type i -> String -> FSA Integer String
from Type i
ty = (String -> FSA Integer String)
-> (FSA Integer String -> FSA Integer String)
-> Either String (FSA Integer String)
-> FSA Integer String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> FSA Integer String
forall a. HasCallStack => String -> a
error FSA Integer String -> FSA Integer String
forall a. a -> a
id (Either String (FSA Integer String) -> FSA Integer String)
-> (String -> Either String (FSA Integer String))
-> String
-> FSA Integer String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type i -> String -> Either String (FSA Integer String)
forall i.
Importable i =>
Type i -> String -> Either String (FSA Integer String)
fromE Type i
ty

> -- |Try to create an 'FSA' from a @String@ treated as the given 'Type'.
> fromE :: (Importable i) =>
>          Type i -> String -> Either String (FSA Integer String)
> fromE :: Type i -> String -> Either String (FSA Integer String)
fromE Type i
ty = Type i -> String -> Either String (FSA Integer String)
forall i.
Importable i =>
Type i -> String -> Either String (FSA Integer String)
toFSA Type i
ty

> -- |Create a @String@ from an 'FSA', formatted appropriately for
> -- the given 'Type'.
> to :: (Ord n, Ord e, Show n, Show e, Exportable x) =>
>       Type x -> FSA n e -> String
> to :: Type x -> FSA n e -> String
to Type x
ty = Type x -> FSA n e -> String
forall t n e.
(Exportable t, Ord n, Ord e, Show n, Show e) =>
(t -> t) -> FSA n e -> String
fromFSA Type x
ty

> -- |An importable or exportable format.
> type Type t = t -> t

=== Instances for Jeff's format

> -- |Jeff's format.
> newtype Jeff = Jeff Jeff

> instance Exportable Jeff
>     where fromFSA :: (Jeff -> Jeff) -> FSA n e -> String
fromFSA Jeff -> Jeff
_ = FSA n e -> String
forall e n. (Ord e, Ord n, Show e) => FSA n e -> String
exportJeff

> instance Importable Jeff
>     where toFSA :: (Jeff -> Jeff) -> String -> Either String (FSA Integer String)
toFSA Jeff -> Jeff
_ = (FSA Int String -> FSA Integer String)
-> Either String (FSA Int String)
-> Either String (FSA Integer String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FSA Int String -> FSA Integer String
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (Either String (FSA Int String)
 -> Either String (FSA Integer String))
-> (String -> Either String (FSA Int String))
-> String
-> Either String (FSA Integer String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (FSA Int String)
readJeff

=== instances for Dot format

> -- |The GraphViz Dot format.
> newtype Dot = Dot Dot

> instance Exportable Dot
>     where fromFSA :: (Dot -> Dot) -> FSA n e -> String
fromFSA Dot -> Dot
_ = FSA n e -> String
forall e n. (Ord e, Ord n, Show e, Show n) => FSA n e -> String
exportDot

=== instances for Pleb format

> -- |The format defined by the (P)iecewise / (L)ocal (E)xpression (B)uilder.
> newtype Pleb = Pleb Pleb

> instance Importable Pleb
>     where toFSA :: (Pleb -> Pleb) -> String -> Either String (FSA Integer String)
toFSA Pleb -> Pleb
_ = String -> Either String (FSA Integer String)
readPleb

=== instances for ATT format

> -- |The AT&T finite-state transducer format, input projection
> --
> -- @since 0.3
> newtype ATT = ATT ATT

> instance Importable ATT
>     where toFSA :: (ATT -> ATT) -> String -> Either String (FSA Integer String)
toFSA ATT -> ATT
_ = FSA Integer String -> Either String (FSA Integer String)
forall a b. b -> Either a b
Right (FSA Integer String -> Either String (FSA Integer String))
-> (String -> FSA Integer String)
-> String
-> Either String (FSA Integer String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FSA Integer String
readATT

> instance Exportable ATT
>     where fromFSA :: (ATT -> ATT) -> FSA n e -> String
fromFSA ATT -> ATT
_ = FSA n e -> String
forall n e. (Ord n, Ord e, Show e) => FSA n e -> String
exportATT

> -- |The AT&T finite-state transducer format, output projection
> --
> -- @since 0.3
> newtype ATTO = ATTO ATTO

> instance Importable ATTO
>     where toFSA :: (ATTO -> ATTO) -> String -> Either String (FSA Integer String)
toFSA ATTO -> ATTO
_ = FSA Integer String -> Either String (FSA Integer String)
forall a b. b -> Either a b
Right (FSA Integer String -> Either String (FSA Integer String))
-> (String -> FSA Integer String)
-> String
-> Either String (FSA Integer String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FSA Integer String
readATT (String -> FSA Integer String)
-> (String -> String) -> String -> FSA Integer String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
invertATT

> instance Exportable ATTO
>     where fromFSA :: (ATTO -> ATTO) -> FSA n e -> String
fromFSA ATTO -> ATTO
_ = String -> String
invertATT (String -> String) -> (FSA n e -> String) -> FSA n e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> String
forall n e. (Ord n, Ord e, Show e) => FSA n e -> String
exportATT

> -- |A corpus of strings
> --
> -- @since 0.3
> newtype Corpus = Corpus Corpus

> instance Importable Corpus
>     where toFSA :: (Corpus -> Corpus) -> String -> Either String (FSA Integer String)
toFSA Corpus -> Corpus
_ = FSA Integer String -> Either String (FSA Integer String)
forall a b. b -> Either a b
Right (FSA Integer String -> Either String (FSA Integer String))
-> (String -> FSA Integer String)
-> String
-> Either String (FSA Integer String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                     FSA String String -> FSA Integer String
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA String String -> FSA Integer String)
-> (String -> FSA String String) -> String -> FSA Integer String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> FSA String Char -> FSA String String
forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (FSA String Char -> FSA String String)
-> (String -> FSA String Char) -> String -> FSA String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                     [String] -> FSA String Char
forall a. Ord a => [[a]] -> FSA [a] a
readCorpus ([String] -> FSA String Char)
-> (String -> [String]) -> String -> FSA String Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines